HELP=> Unale To Resolve VB Code Issues !!!


T

tommo_blade

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...
 
Ad

Advertisements

J

Joel

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?
 
Ad

Advertisements

J

JLGWhiz

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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top