Barryj
11-06-2007, 08:00 AM
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
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