Help with making code more flexible

[Barryj]

The code that I have works great as is but I was hoping to make it a little more flexible, currently when there is a "A", "B", "C" in column A when the macro runs it will send the information to sheets A Grade Rd 1 or B Grade Rd1 or sheet Gross

I was hoping to be able to add some coding so that if cell O2 on sheet Single Stroke reads STROKE and there is a C in column A then the information will be sent to a sheet named GROSS

If O2 reads 1st Round Championships and there is a A in column A then the information will be sent to A Grade Rd1 or a B in column A then the information will be sent to B Grade Rd1

I would like to do this for the other 2 rounds which will be 2nd and 3rd Round Championships and the information will be sent to the respective sheets, A Grade Rd2 B Grade Rd2 and A Grade Rd3 B Grade Rd3

Below is the code that I am using at the moment

[vba]Dim rng As Range
' Set the range as Dynamic
Set rng = Range([B13], [V65536].End(xlUp))
Dim r As Range, grade, c As Range
Dim i As Integer, sn, x As Range
grade = Array("C", "A", "B")
sn = Array("Gross", "A Grade Rd1", "B Grade Rd1")
Application.ScreenUpdating = False
For i = LBound(sn) To UBound(sn)
Sheets(sn(i)).Cells.Resize(Cells.Rows.Count - 1).Offset(1).ClearContents
Next
With Sheets("Single Stroke")
For Each r In .Range("a11", .Range("a65536").End(xlUp))
If r.Offset(0, 1).Value = "" Then GoTo SkipIt1
For i = LBound(grade) To UBound(grade)
If r.Value = grade(i) Then
Set x = Sheets(sn(i)).Range("a65536").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(, 23).Value
x.Offset(, 3).Value = r.Offset(, 24).Value
x.Offset(, 4).Value = r.Offset(, 21).Value
x.Offset(, 5).Value = r.Offset(, 20).Value
x.Offset(, 6).Value = r.Offset(, 19).Value
Exit For
End If
SkipIt1:
Next
Next
End With
Application.ScreenUpdating = False

End Sub[/vba]
So what I am after is the information will be sent to the relevant sheet depending on what is in cell O2 on sheet Single Stroke.

Hope this make some sense.

Thanks for any replys

[mdmackillop]

Hi Barry,
Can you post a workbook containing the worksheets and some data.

[Barryj]

Thanks for the reply MD, I have thought about this a little more and I hope this can be achieved without to much trouble.

When the word Stroke appears on the worksheet Single stroke I would like all scores to go to the sheet named Gross1.

When the word 1st Round Championships appears I would like the scores to go to Gross1 and A Grade1 if a A appeares in colum A and B Grade1 if a B appeares in column A.

When 2nd Round Championships appears I would like scores to be sent to Gross1, A Grade2 if a A appears in colum A and B Grade2 if a B appears in column A.

If 3rd Round Championships appears I would like to sentd scores to Gross1
A Grade3 if a A appears in column A and to B Grade3 if a B appears in column A.

On the sheet Single Stroke there is a drop down box to change between the relevant rounds.

If a player handicapp is higher than 18 then they will have a B in column A or if = or lower than 18 then it will be a A.

I hope the attachment will enable you to understand how the information should be distributed.

[geekgirlau]

[vba]
Option Explicit
Private Sub WorkSheet_Calculate()
Dim wks As Worksheet
Dim r As Range
Dim x As Range
Dim sn() As String
Dim i As Integer


sn = Array("Gross1", "A Grade1", "B Grade1", "A Grade2", "B Grade2", _
"A Grade3", "B Grade3")

Application.ScreenUpdating = False

For i = LBound(sn) To UBound(sn)
Sheets(sn(i)).Cells.ClearContents
Next

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
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"
Set wks = Worksheets(r.Value & " Grade1")

Case "2nd Round Championships"
Set wks = Worksheets(r.Value & " Grade2")

Case "3rd Round Championships"
Set wks = Worksheets(r.Value & " Grade3")

Case Else
GoTo SkipIt1
End Select

' write values
With wks
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
End With
SkipIt1:
Next r
End With

Application.ScreenUpdating = True
End Sub
[/vba]

I'd also suggest that you activate your code on Worksheet Change rather than Worksheet Calculate. You really only want your code to run if the round changes, so you can add this at the start of your code to test what cell has been changed:

[VBA]
If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Range("O2")) Is Nothing Then Exit Sub

[/VBA]

[Barryj]

Thanks for the help Geekgirl, but I am getting a type mismatch error on line
[VBA] sn = Array("Gross1", "A Grade1", "B Grade1", "A Grade2", "B Grade2", _
"A Grade3", "B Grade3")
[/VBA]
Any thoughts?

[JonPeltier]

Use this in the declarations:

[VBA]
Dim sn As Variant
[/VBA]

[Barryj]

Thanks Jon that did the trick, when I change from 1st Round of Championships to the next Round the scores are wiped from the previous Round is there a way of retaining this data instead of it being deleted.

[JonPeltier]

I haven't taken the time to understand the whole problem statement and code samples in this thread. Aren't the scores written to a new sheet for each round?

[Barryj]

Yes they are, but when they are written to the new sheet the scores are no longer in the last sheet? If scores are written to A Grade1, when they are written to A Grade2 the previous scores are no longer in A Grade1?

Any thoughts why that maybe happening?

[geekgirlau]

Change this line

[VBA]
For i = LBound(sn) To UBound(sn)
Sheets(sn(i)).Cells.ClearContents
Next
[/VBA]

to this

[VBA]
For i = LBound(sn) To UBound(sn)
Sheets(sn(i)).Cells.Resize(Cells.Rows.Count - 1).Offset(1).ClearContents
Next
[/VBA]

[Barryj]

Hi Geekgirl, it is still clearing the data from the other sheets.

[geekgirlau]

Comment out those 3 lines - I thought initially that you wanted to clear the data and that's why they were there!

[Barryj]

Geekgirl, I have modified the code to add a second lot of sheets, but when I comment out the 3 lines you suggested I get the same data mutiplyed down the destination sheet, and nothing goes to sheet Gross1.

If I put the 3 lines in again the data is fine but is deleted from the other sheets as previous.

Here is the code as modified

[VBA]Option Explicit
Private Sub Worksheet_Calculate()

Dim wks As Worksheet
Dim r As Range
Dim x As Range
Dim sn As Variant
Dim i As Integer
sn = Array("Gross1", "A Grade1", "B Grade1", "A Grade2", "B Grade2", _
"A Grade3", "B Grade3")

Application.ScreenUpdating = False
For i = LBound(sn) To UBound(sn)
Sheets(sn(i)).Cells.Resize(Cells.Rows.Count - 1).Offset(1).ClearContents
Next
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"
Set wks = Worksheets(r.Value & " Grade1")

Case "2nd Round Championships"
Set wks = Worksheets(r.Value & " Grade2")

Case "3rd Round Championships"
Set wks = Worksheets(r.Value & " Grade3")

Case Else
GoTo SkipIt1
End Select

' write values
With wks
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
SkipIt1:
Next r
End With

Application.ScreenUpdating = True

sn = Array("Gross1", "A GradeNett1", "B GradeNett1", "A GradeNett2", "B GradeNett2", _
"A GradeNett3", "B GradeNett3")

Application.ScreenUpdating = False
For i = LBound(sn) To UBound(sn)
Sheets(sn(i)).Cells.Resize(Cells.Rows.Count - 1).Offset(1).ClearContents
Next
With Sheets("Single Stroke")
For Each r In .Range("a11", .Range("a65536").End(xlUp))

If r.Value = "" Then GoTo SkipIt2

' 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(, 23).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"
Set wks = Worksheets(r.Value & " GradeNett1")

Case "2nd Round Championships"
Set wks = Worksheets(r.Value & " GradeNett2")

Case "3rd Round Championships"
Set wks = Worksheets(r.Value & " GradeNett3")

Case Else
GoTo SkipIt2
End Select

' write values
With wks
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(, 23).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
SkipIt2:
Next r
End With

Application.ScreenUpdating = True
End Sub
[/VBA]

I have left the 3 lines you suggested taking out at the moment, any other suggestions I could try?

[geekgirlau]

Okay, so let's clarify:

When you change the round, should data be cleared from ANY of the other sheets? If so, which ones?

[Barryj]

Data will only need to be cleared from sheet Gross1, I need all other data to remain.

Thanks again for your help.

[geekgirlau]

I've moved the code to the Worksheet Change event, so you'll need to delete the Worksheet Calculate code.

[vba]
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")

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 i
SkipIt1:
Next r
End With

Application.ScreenUpdating = True
End Sub

[/vba]

[Barryj]

I Put the new code in, it is not transfering data to rounds 1, 2,or 3 only to sheet Gross1, and only if cell O2 is changed.

[geekgirlau]

If you really want to have this code run every time the workbook calculates, you can move it back to the calculate event for the sheet and remove these 2 lines at the start of the code:

[VBA]
If Target.Cells.Count > 1 Then Exit Sub

If Intersect(Target, Range("O2")) Is Nothing Then Exit Sub

[/VBA]

If any user has automatic calculation switched on, this will result in lots of duplicate records, one set for every time they make any change anywhere on the sheet.

[Barryj]

I am still not able to solve this problem so I am going for a slightly and hoplfully a eaiser option.

In the following code I am trying to get the first half of the macro to send the data to sheet Gross1 along with the other sheets depending on the grade selected.

All works well sending info to sheets A Grade1, B Grade1, A GradeNett1, B GradeNett1 and NCR sheet, how can I include sheet Gross1 to receive data, from the first half of the macro ie: A Grade1 or B Grade1.
Code at moment is as follows

[VBA] Dim rng As Range
' Set the range as Dynamic
Set rng = Range([B13], [V65536].End(xlUp))
Dim r As Range, grade, c As Range
Dim i As Integer, sn, x As Range
grade = Array("A", "B", "NCR")
sn = Array("A Grade1", "B Grade1", "NCR", "Gross1")
Application.ScreenUpdating = False
With Sheets("Workings")
For Each r In .Range("a13", .Range("a65536").End(xlUp))
If r.Offset(0, 1).Value = "" Then GoTo SkipIt1
For i = LBound(grade) To UBound(grade)
If r.Value = grade(i) Then
Set x = Sheets(sn(i)).Range("a65536").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
Exit For
End If
SkipIt1:
Next
Next
End With
Application.ScreenUpdating = False
grade = Array("A", "B")
sn = Array("A GradeNett1", "B GradeNett1")
Application.ScreenUpdating = False
With Sheets("Workings")
For Each r In .Range("a13", .Range("a65536").End(xlUp))
For i = LBound(grade) To UBound(grade)
If r.Offset(0, 1).Value = "" Then GoTo SkipIt2
If r.Value = grade(i) Then
Set x = Sheets(sn(i)).Range("a65536").End(xlUp).Offset(1)
x.Value = r.Offset(, 1).Value
x.Offset(, 1).Resize(, 2).Value = r.Offset(, 23).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
Exit For
End If
SkipIt2:
Next
Next
End With
Application.ScreenUpdating = False
[/VBA]