Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > HELP= Unale To Resolve VB Code Issues !!!
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 31
Default HELP= Unale To Resolve VB Code Issues !!!
Hi, can anyone help me resolve the following problem:-

I have imported a worksheet into my workbook, this worksheet has some
VB code behind it, in my workbook I then run a macro that will update
this imported worksheet, it is when I try to update the worksheet
that
an error is thrown up, the error is shown below:

Run-time error '1004':
Application-defined or object-defined error

**note that the worksheet VB code works OK without error prior to
importing into my workbook.


The VB in the imported worksheet has some code that sets the colour
of
cells depending on the cell value, the macro that I run from within
the workbook is putting a value into these cells and I am wanting the
imported worksheet VB code to then change the cell colour dependant
upon the data I put into these cells, the problem is that it throws
the above error. I have put the 2 pieces of code below, the direst is
the VB in the imported worksheet, the line with the '== <==' is the
line that is failing, the 2nd piece of code is the macro that is run.


Imported wprksheet VB code
---------------------------------------------------------------------------*-------
Private Sub Worksheet_Change(ByVal Target As Range)


Dim TeamCount As Integer


Dim myCols(12)
myCols(1) = "5"
myCols(2) = "7"
myCols(3) = "9"
myCols(4) = "11"
myCols(5) = "13"
myCols(6) = "15"
myCols(7) = "17"
myCols(8) = "19"
myCols(9) = "21"
myCols(10) = "23"
myCols(11) = "25"
myCols(12) = "27"


For i = 1 To 12
If Target.Column = myCols(i) Then
InputValue = Target.Value


If InputValue = "N" Then
== Target.Interior.ColorIndex = 3 <==
ElseIf InputValue 0 Then
Target.Interior.ColorIndex = 38
Else
Target.Interior.ColorIndex = white
End If
End If
Next i


If Target.Column = 3 Then
For x = 8 To 18
TeamCount = 0
For y = 8 To 18
If Target.Worksheet.Cells(x, 3) =
Target.Worksheet.Cells(y, 3) And Target.Worksheet.Cells(x, 3) < ""
Then
TeamCount = TeamCount + 1
End If
Next y


If TeamCount 2 Then
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 3
Else
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 0
End If
Next x
End If


End Sub





2nd piece of code - workbook macro
---------------------------------------------------------------
Sub ControlSheet_UpdateTeamsBtn_Click()


Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim w As Integer
Dim acol As Integer
Dim dcol As Integer
Dim player As String
Dim club As String
Dim position As String
Dim iReply As Integer
Dim pos As String
Dim pos_col As Integer
Dim wks As Worksheet


On Error GoTo canceled
iReply = InputBox(Prompt:="Enter The Week (1-6):", _
Title:="UPDATE TEAMSHEETS", Default:="0")


If iReply = 0 Then
MsgBox "YOU DID NOT ENTER A VALID WEEK NUMBER (1-6 Only)"
Exit Sub
End If
If iReply = 1 Then
acol = 5
dcol = 17
'MsgBox "Week1 - Column 5"
ElseIf iReply = 2 Then
acol = 7
dcol = 19
'MsgBox "Week2 - Column 7"
ElseIf iReply = 3 Then
acol = 9
dcol = 21
'MsgBox "Week3 - Column 9"
ElseIf iReply = 4 Then
acol = 11
dcol = 23
'MsgBox "Week4 - Column 11"
ElseIf iReply = 5 Then
acol = 13
dcol = 25
'MsgBox "Week5 - Column 13"
ElseIf iReply = 6 Then
acol = 15
dcol = 27
'MsgBox "Week6 - Column 15"
End If


For z = 1 To 1000
If ActiveSheet.Cells(z, 1).Value < "" Then
MyData = Split(ActiveSheet.Cells(z, 1).Value, ":")
player = MyData(2)
club = MyData(1)
position = MyData(0)
If ActiveSheet.Cells(z, 2).Value < "N" Then
goals_scored = ActiveSheet.Cells(z, 2)
clean_sheet = ActiveSheet.Cells(z, 3)
'MsgBox "MATCH DATA FOUND:" & player & "#GOAL SCORED:" &
goals_scored & "#CLEAN SHEET:" & clean_sheet
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 2) = "FF" Then
'MsgBox "WORKSHEET: " & wks.Name & "<--Looking for
PLAYER:" & player
Set f = wks.Columns("B").Find(what:=player,
LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
'MsgBox player & " FOUND IN ROW: " & f.row & ",
UPDATING DATA: " & goals_scored
pos = wks.Cells(f.row, 1)
'MsgBox "THIS PLAYER IS A:" & pos
If wks.Cells(f.row, acol).Value < "N" Then
'MsgBox "SCORES ALREADY UPDATED FOR WEEK: " &
iReply
Exit Sub
End If
'MsgBox "1.MODIFY CELL: " & f.row & "#" & acol
wks.Cells(f.row, acol) = goals_scored
If Left(pos, 2) = "GK" Then
wks.Cells(f.row, dcol) = clean_sheet
ElseIf Left(pos, 3) = "DEF" Then
wks.Cells(f.row, dcol) = clean_sheet
End If
Else
'MsgBox player & " NOT FOUND ON WORKSHEET:" &
wks.Name
End If
Else
'MsgBox "NOT FF TEAMSHEET:" & wks.Name
End If


Next wks
End If
End If
Next z


canceled:
End Sub




thanks for any assistance...
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default HELP= Unale To Resolve VB Code Issues !!!
I don't see anything wrong. It may be that that worksheet you added doesn't
have 12 columns. When the error occurs which line is highlighted?

"tommo_blade" wrote:

Hi, can anyone help me resolve the following problem:-

I have imported a worksheet into my workbook, this worksheet has some
VB code behind it, in my workbook I then run a macro that will update
this imported worksheet, it is when I try to update the worksheet
that
an error is thrown up, the error is shown below:

Run-time error '1004':
Application-defined or object-defined error

**note that the worksheet VB code works OK without error prior to
importing into my workbook.


The VB in the imported worksheet has some code that sets the colour
of
cells depending on the cell value, the macro that I run from within
the workbook is putting a value into these cells and I am wanting the
imported worksheet VB code to then change the cell colour dependant
upon the data I put into these cells, the problem is that it throws
the above error. I have put the 2 pieces of code below, the direst is
the VB in the imported worksheet, the line with the '== <==' is the
line that is failing, the 2nd piece of code is the macro that is run.


Imported wprksheet VB code
---------------------------------------------------------------------------Â*-------
Private Sub Worksheet_Change(ByVal Target As Range)


Dim TeamCount As Integer


Dim myCols(12)
myCols(1) = "5"
myCols(2) = "7"
myCols(3) = "9"
myCols(4) = "11"
myCols(5) = "13"
myCols(6) = "15"
myCols(7) = "17"
myCols(8) = "19"
myCols(9) = "21"
myCols(10) = "23"
myCols(11) = "25"
myCols(12) = "27"


For i = 1 To 12
If Target.Column = myCols(i) Then
InputValue = Target.Value


If InputValue = "N" Then
== Target.Interior.ColorIndex = 3 <==
ElseIf InputValue 0 Then
Target.Interior.ColorIndex = 38
Else
Target.Interior.ColorIndex = white
End If
End If
Next i


If Target.Column = 3 Then
For x = 8 To 18
TeamCount = 0
For y = 8 To 18
If Target.Worksheet.Cells(x, 3) =
Target.Worksheet.Cells(y, 3) And Target.Worksheet.Cells(x, 3) < ""
Then
TeamCount = TeamCount + 1
End If
Next y


If TeamCount 2 Then
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 3
Else
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 0
End If
Next x
End If


End Sub





2nd piece of code - workbook macro
---------------------------------------------------------------
Sub ControlSheet_UpdateTeamsBtn_Click()


Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim w As Integer
Dim acol As Integer
Dim dcol As Integer
Dim player As String
Dim club As String
Dim position As String
Dim iReply As Integer
Dim pos As String
Dim pos_col As Integer
Dim wks As Worksheet


On Error GoTo canceled
iReply = InputBox(Prompt:="Enter The Week (1-6):", _
Title:="UPDATE TEAMSHEETS", Default:="0")


If iReply = 0 Then
MsgBox "YOU DID NOT ENTER A VALID WEEK NUMBER (1-6 Only)"
Exit Sub
End If
If iReply = 1 Then
acol = 5
dcol = 17
'MsgBox "Week1 - Column 5"
ElseIf iReply = 2 Then
acol = 7
dcol = 19
'MsgBox "Week2 - Column 7"
ElseIf iReply = 3 Then
acol = 9
dcol = 21
'MsgBox "Week3 - Column 9"
ElseIf iReply = 4 Then
acol = 11
dcol = 23
'MsgBox "Week4 - Column 11"
ElseIf iReply = 5 Then
acol = 13
dcol = 25
'MsgBox "Week5 - Column 13"
ElseIf iReply = 6 Then
acol = 15
dcol = 27
'MsgBox "Week6 - Column 15"
End If


For z = 1 To 1000
If ActiveSheet.Cells(z, 1).Value < "" Then
MyData = Split(ActiveSheet.Cells(z, 1).Value, ":")
player = MyData(2)
club = MyData(1)
position = MyData(0)
If ActiveSheet.Cells(z, 2).Value < "N" Then
goals_scored = ActiveSheet.Cells(z, 2)
clean_sheet = ActiveSheet.Cells(z, 3)
'MsgBox "MATCH DATA FOUND:" & player & "#GOAL SCORED:" &
goals_scored & "#CLEAN SHEET:" & clean_sheet
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 2) = "FF" Then
'MsgBox "WORKSHEET: " & wks.Name & "<--Looking for
PLAYER:" & player
Set f = wks.Columns("B").Find(what:=player,
LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
'MsgBox player & " FOUND IN ROW: " & f.row & ",
UPDATING DATA: " & goals_scored
pos = wks.Cells(f.row, 1)
'MsgBox "THIS PLAYER IS A:" & pos
If wks.Cells(f.row, acol).Value < "N" Then
'MsgBox "SCORES ALREADY UPDATED FOR WEEK: " &
iReply
Exit Sub
End If
'MsgBox "1.MODIFY CELL: " & f.row & "#" & acol
wks.Cells(f.row, acol) = goals_scored
If Left(pos, 2) = "GK" Then
wks.Cells(f.row, dcol) = clean_sheet
ElseIf Left(pos, 3) = "DEF" Then
wks.Cells(f.row, dcol) = clean_sheet
End If
Else
'MsgBox player & " NOT FOUND ON WORKSHEET:" &
wks.Name
End If
Else
'MsgBox "NOT FF TEAMSHEET:" & wks.Name
End If


Next wks
End If
End If
Next z


canceled:
End Sub




thanks for any assistance...

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 3,986
Default HELP= Unale To Resolve VB Code Issues !!!
The procedure ran OK on my system. "N" turned red in the columns specified
and did not cause a change when put in any other column.

"tommo_blade" wrote:

Hi, can anyone help me resolve the following problem:-

I have imported a worksheet into my workbook, this worksheet has some
VB code behind it, in my workbook I then run a macro that will update
this imported worksheet, it is when I try to update the worksheet
that
an error is thrown up, the error is shown below:

Run-time error '1004':
Application-defined or object-defined error

**note that the worksheet VB code works OK without error prior to
importing into my workbook.


The VB in the imported worksheet has some code that sets the colour
of
cells depending on the cell value, the macro that I run from within
the workbook is putting a value into these cells and I am wanting the
imported worksheet VB code to then change the cell colour dependant
upon the data I put into these cells, the problem is that it throws
the above error. I have put the 2 pieces of code below, the direst is
the VB in the imported worksheet, the line with the '== <==' is the
line that is failing, the 2nd piece of code is the macro that is run.


Imported wprksheet VB code
---------------------------------------------------------------------------Â*-------
Private Sub Worksheet_Change(ByVal Target As Range)


Dim TeamCount As Integer


Dim myCols(12)
myCols(1) = "5"
myCols(2) = "7"
myCols(3) = "9"
myCols(4) = "11"
myCols(5) = "13"
myCols(6) = "15"
myCols(7) = "17"
myCols(8) = "19"
myCols(9) = "21"
myCols(10) = "23"
myCols(11) = "25"
myCols(12) = "27"


For i = 1 To 12
If Target.Column = myCols(i) Then
InputValue = Target.Value


If InputValue = "N" Then
== Target.Interior.ColorIndex = 3 <==
ElseIf InputValue 0 Then
Target.Interior.ColorIndex = 38
Else
Target.Interior.ColorIndex = white
End If
End If
Next i


If Target.Column = 3 Then
For x = 8 To 18
TeamCount = 0
For y = 8 To 18
If Target.Worksheet.Cells(x, 3) =
Target.Worksheet.Cells(y, 3) And Target.Worksheet.Cells(x, 3) < ""
Then
TeamCount = TeamCount + 1
End If
Next y


If TeamCount 2 Then
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 3
Else
Target.Worksheet.Cells(x, 3).Interior.ColorIndex = 0
End If
Next x
End If


End Sub





2nd piece of code - workbook macro
---------------------------------------------------------------
Sub ControlSheet_UpdateTeamsBtn_Click()


Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim w As Integer
Dim acol As Integer
Dim dcol As Integer
Dim player As String
Dim club As String
Dim position As String
Dim iReply As Integer
Dim pos As String
Dim pos_col As Integer
Dim wks As Worksheet


On Error GoTo canceled
iReply = InputBox(Prompt:="Enter The Week (1-6):", _
Title:="UPDATE TEAMSHEETS", Default:="0")


If iReply = 0 Then
MsgBox "YOU DID NOT ENTER A VALID WEEK NUMBER (1-6 Only)"
Exit Sub
End If
If iReply = 1 Then
acol = 5
dcol = 17
'MsgBox "Week1 - Column 5"
ElseIf iReply = 2 Then
acol = 7
dcol = 19
'MsgBox "Week2 - Column 7"
ElseIf iReply = 3 Then
acol = 9
dcol = 21
'MsgBox "Week3 - Column 9"
ElseIf iReply = 4 Then
acol = 11
dcol = 23
'MsgBox "Week4 - Column 11"
ElseIf iReply = 5 Then
acol = 13
dcol = 25
'MsgBox "Week5 - Column 13"
ElseIf iReply = 6 Then
acol = 15
dcol = 27
'MsgBox "Week6 - Column 15"
End If


For z = 1 To 1000
If ActiveSheet.Cells(z, 1).Value < "" Then
MyData = Split(ActiveSheet.Cells(z, 1).Value, ":")
player = MyData(2)
club = MyData(1)
position = MyData(0)
If ActiveSheet.Cells(z, 2).Value < "N" Then
goals_scored = ActiveSheet.Cells(z, 2)
clean_sheet = ActiveSheet.Cells(z, 3)
'MsgBox "MATCH DATA FOUND:" & player & "#GOAL SCORED:" &
goals_scored & "#CLEAN SHEET:" & clean_sheet
For Each wks In ThisWorkbook.Worksheets
If Left(wks.Name, 2) = "FF" Then
'MsgBox "WORKSHEET: " & wks.Name & "<--Looking for
PLAYER:" & player
Set f = wks.Columns("B").Find(what:=player,
LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
'MsgBox player & " FOUND IN ROW: " & f.row & ",
UPDATING DATA: " & goals_scored
pos = wks.Cells(f.row, 1)
'MsgBox "THIS PLAYER IS A:" & pos
If wks.Cells(f.row, acol).Value < "N" Then
'MsgBox "SCORES ALREADY UPDATED FOR WEEK: " &
iReply
Exit Sub
End If
'MsgBox "1.MODIFY CELL: " & f.row & "#" & acol
wks.Cells(f.row, acol) = goals_scored
If Left(pos, 2) = "GK" Then
wks.Cells(f.row, dcol) = clean_sheet
ElseIf Left(pos, 3) = "DEF" Then
wks.Cells(f.row, dcol) = clean_sheet
End If
Else
'MsgBox player & " NOT FOUND ON WORKSHEET:" &
wks.Name
End If
Else
'MsgBox "NOT FF TEAMSHEET:" & wks.Name
End If


Next wks
End If
End If
Next z


canceled:
End Sub




thanks for any assistance...

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
VB Code Issues Bob1866 Excel Discussion (Misc queries) 1 August 30th 09 11:58 PM
Help with code issues Mekinnik Excel Programming 5 November 4th 07 04:51 PM
Help with code issues Mekinnik Excel Programming 0 October 31st 07 03:51 PM
Help with code issues Mekinnik Excel Programming 2 October 16th 07 01:34 PM
Have two hard issues... I can't seem to resolve!!! trward79 Excel Programming 2 October 7th 06 06:51 PM


All times are GMT +1. The time now is 09:16 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement