Barryj
07-03-2008, 05:08 PM
I am trying to modify this code to get it to put data into some sheets that I have added, NCR ,NCR1, NCR2, NCR3.What needs to happen is that when stroke is selected if a player has NCR nect to their name then the player ends up in sheet NCR.If 1st Round Championships is selected and the player has NCR next their name then the player ends up in sheet NCR1 and the same principal for rounds 2 and 3.The rest of the code works fine except for this and I am getting an error on this line of the code.
Set wks = Worksheets(strSheet(i))
This is the full code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim r As Range
Dim x As Range
Dim strSheet(0 To 1) As String
Dim sn As Variant
Dim i As Integer
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("O2")) Is Nothing Then Exit Sub
sn = Array("Gross1", "A Grade1", "B Grade1", "A Grade2", "B Grade2", _
"A Grade3", "B Grade3", "A GradeNett1", "B GradeNett1", "A GradeNett2", _
"B GradeNett2", "A GradeNett3", "B GradeNett3", "NCR", "NCR1", "NCR2", "NCR3")
Application.ScreenUpdating = False ' ONLY clear data in Gross1
Sheets("Gross1").Cells.ClearContents
With Sheets("Single Stroke")
For Each r In .Range("a11", .Range("a65536").End(xlUp))
If r.Value = "" Then GoTo SkipIt1 ' values are always written to Gross1 sheet
With Sheets("Gross1")
Set x = .Range("a" & Cells.Rows.Count).End(xlUp).Offset(1) x.Value = r.Offset(, 1).Value
x.Offset(, 1).Resize(, 2).Value = r.Offset(, 22).Resize(, 1).Value
x.Offset(, 2).Value = r.Offset(, 24).Value
x.Offset(, 3).Value = r.Offset(, 21).Value
x.Offset(, 4).Value = r.Offset(, 20).Value
x.Offset(, 5).Value = r.Offset(, 19).Value
x.Offset(, 6).Value = r.Offset(, 25).Value
x.Offset(, 7).Value = r.Offset(, 26).Value
x.Offset(, 8).Value = r.Offset(, 27).Value
x.Offset(, 9).Value = r.Offset(, 28).Value
End With
' set the target worksheet based on the round and player grade
Select Case Sheets("Single Stroke").Range("O2").Value
Case "1st Round Championships"
strSheet(0) = r.Value & " Grade1" strSheet(1) = r.Value & " GradeNett1"
Case "2nd Round Championships"
strSheet(0) = r.Value & " Grade2" strSheet(1) = r.Value & " GradeNett2"
Case "3rd Round Championships"
strSheet(0) = r.Value & " Grade3" strSheet(1) = r.Value & " GradeNett3"
Case Else ' if round is "Stroke", don't need to write the data ' anywhere else GoTo SkipIt1 End Select
' write values
For i = 0 To UBound(strSheet) Set wks = Worksheets(strSheet(i))
With wks Set x = .Range("a" & Cells.Rows.Count).End(xlUp).Offset(1) x.Value = r.Offset(, 1).Value
If i = 0 Then x.Offset(, 1).Resize(, 2).Value = r.Offset(, 22).Resize(, 1).Value
Else
x.Offset(, 1).Resize(, 2).Value = r.Offset(, 23).Resize(, 1).Value
End If
x.Offset(, 2).Value = r.Offset(, 24).Value
x.Offset(, 3).Value = r.Offset(, 21).Value
x.Offset(, 4).Value = r.Offset(, 20).Value
x.Offset(, 5).Value = r.Offset(, 19).Value
x.Offset(, 6).Value = r.Offset(, 25).Value
x.Offset(, 7).Value = r.Offset(, 26).Value
x.Offset(, 8).Value = r.Offset(, 27).Value
x.Offset(, 9).Value = r.Offset(, 28).Value
End With
Next iSkipIt1:
Next r
End With
Application.ScreenUpdating = True
End Sub
Can anybody give me any thoughts on this?
Thanks for any assistance.
Set wks = Worksheets(strSheet(i))
This is the full code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim r As Range
Dim x As Range
Dim strSheet(0 To 1) As String
Dim sn As Variant
Dim i As Integer
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("O2")) Is Nothing Then Exit Sub
sn = Array("Gross1", "A Grade1", "B Grade1", "A Grade2", "B Grade2", _
"A Grade3", "B Grade3", "A GradeNett1", "B GradeNett1", "A GradeNett2", _
"B GradeNett2", "A GradeNett3", "B GradeNett3", "NCR", "NCR1", "NCR2", "NCR3")
Application.ScreenUpdating = False ' ONLY clear data in Gross1
Sheets("Gross1").Cells.ClearContents
With Sheets("Single Stroke")
For Each r In .Range("a11", .Range("a65536").End(xlUp))
If r.Value = "" Then GoTo SkipIt1 ' values are always written to Gross1 sheet
With Sheets("Gross1")
Set x = .Range("a" & Cells.Rows.Count).End(xlUp).Offset(1) x.Value = r.Offset(, 1).Value
x.Offset(, 1).Resize(, 2).Value = r.Offset(, 22).Resize(, 1).Value
x.Offset(, 2).Value = r.Offset(, 24).Value
x.Offset(, 3).Value = r.Offset(, 21).Value
x.Offset(, 4).Value = r.Offset(, 20).Value
x.Offset(, 5).Value = r.Offset(, 19).Value
x.Offset(, 6).Value = r.Offset(, 25).Value
x.Offset(, 7).Value = r.Offset(, 26).Value
x.Offset(, 8).Value = r.Offset(, 27).Value
x.Offset(, 9).Value = r.Offset(, 28).Value
End With
' set the target worksheet based on the round and player grade
Select Case Sheets("Single Stroke").Range("O2").Value
Case "1st Round Championships"
strSheet(0) = r.Value & " Grade1" strSheet(1) = r.Value & " GradeNett1"
Case "2nd Round Championships"
strSheet(0) = r.Value & " Grade2" strSheet(1) = r.Value & " GradeNett2"
Case "3rd Round Championships"
strSheet(0) = r.Value & " Grade3" strSheet(1) = r.Value & " GradeNett3"
Case Else ' if round is "Stroke", don't need to write the data ' anywhere else GoTo SkipIt1 End Select
' write values
For i = 0 To UBound(strSheet) Set wks = Worksheets(strSheet(i))
With wks Set x = .Range("a" & Cells.Rows.Count).End(xlUp).Offset(1) x.Value = r.Offset(, 1).Value
If i = 0 Then x.Offset(, 1).Resize(, 2).Value = r.Offset(, 22).Resize(, 1).Value
Else
x.Offset(, 1).Resize(, 2).Value = r.Offset(, 23).Resize(, 1).Value
End If
x.Offset(, 2).Value = r.Offset(, 24).Value
x.Offset(, 3).Value = r.Offset(, 21).Value
x.Offset(, 4).Value = r.Offset(, 20).Value
x.Offset(, 5).Value = r.Offset(, 19).Value
x.Offset(, 6).Value = r.Offset(, 25).Value
x.Offset(, 7).Value = r.Offset(, 26).Value
x.Offset(, 8).Value = r.Offset(, 27).Value
x.Offset(, 9).Value = r.Offset(, 28).Value
End With
Next iSkipIt1:
Next r
End With
Application.ScreenUpdating = True
End Sub
Can anybody give me any thoughts on this?
Thanks for any assistance.