Alter code to only clear data from target sheet

[Barryj]

I have the following code and being a worksheet calculate code activates on each change in the worksheet.

What I want to acheive is that the data is not cleared for the sheets that the data is not being written to, Data always goes to sheet Gross1, if data is being written to 1st Round of championships I dont want it to clear data from 2nd or 3rd round of championships and the same for the other rounds of the championship.

I am trying to preserve the data once it is written to any one of the championship rounds.

So i was hoping some extra code that would only clear the data of the sheet being written to.

I have included a attachment showing how it works.

This is the code in the workbook that I am using.

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
' 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"
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

[Bob Phillips]

Can you explain what we need to do to see the problem that you have, and how we would know we have seen that problem.

[Barryj]

At the moment the data is cleared from all sheets when scores are entered on the single stroke sheet, or if the round is changed by the drop down list on the sheet single stroke.

What I want to happen is when the round is changed via the drop down list on the stroke sheet that if data was written to say 1st round of championships, when the 2nd round is selected it does not wipe the data from sheets A Grade1 B Grade1, A GradeNett1, B GradeNett1. and the same when 3rd round is selected.

[Barryj]

I guess what I am trying to do is if 1st round of championships is selected I only what the macro to clear data from the gross sheet and A & B grade Rd1 so any data written to the other sheets previously will not be wiped.

[Aussiebear]

Would a selection of Case Select help here? For example if "1st Round" then clear data from "Gross Sheet", "A Grade1" & "B Grade1".

[Barryj]

Yes, that might do, I am trying to preserve the data once it has been written to the sheet and then the next round selected. at the moment it wipes the data from all sheets.

[Aussiebear]

So you want to write the data to the next available line?

[Barryj]

The macro should only fire on the active sheets, so when it changes from 1st round of championshis to the 2nd it wont wipe date form the first round.

[Aussiebear]

Barry, I'm still struggling with the workbook. Others may well have a much better understanding.

How do you currently record data to the sheets, & what triggers this event?

[Barryj]

On the sheet single stroke there is a drop down list that has stroke 1st round championships 2nd round championships 3rd round championships, the desired round is changed from here.

At the moment data is cleared from all sheets when a new selection is made, but being a calculate event it then writes it to the new matching sheet.

I was hoping that it could be altered to only calculate on the sheet that it was writing to and not wipe the data from the other sheets as well.

[Aussiebear]

Barry, I am really hoping others will come in here to assist you. If this was my workbook, I'd probably set it up a little different (which is not what you want to hear).

I'd feel safer I could select the Round type and have another button, (call it Update) to effect the change. This way, I'd select the correct sheet based on the value within the dropbox in cell O2. And i'd look at code which allows me to add data to the next blank line of the target sheet.

However since you are happy with the workbook layout and its just a matter of the code requirements, well there's some very clever people on this forum who may be able to assist you. I'll keep watching this thread to see the end result.