View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
tommo_blade tommo_blade is offline
external usenet poster
 
Posts: 31
Default HELP= Problems Copying WorkBook Sheets

Hello, you were a big help to me with some VB code I had an issue
with, could you help me again if you have the time, I have one last
remaining issue that I cannot work out for myself.

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

The VB in the imported worksheet has some code that sets the colour of
the cell 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

----------------------------------------------------------------------
Many thanks.