Clear Check Box
Hi Ryan,
I wrote another code and i'm trying to use some of yours that you redone for
me as mine is not very efficient.
The code I done is below
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strPrompt As String
Dim intbuttons As Integer
Dim strTitle As String
If Target.Address = Range("L2:M3").Address Then
strPrompt = "Do you want Put Staff into OT Order?"
intbuttons = vbYesNo + vbInformation
strTitle = "Galashiels Staff Overtime Rota © M Neil "
If MsgBox(strPrompt, intbuttons, strTitle) = vbYes Then
Range("A7:D16").Select
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Add
Key:=Range("C7:C16" _
), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff OT").Sort
.SetRange Range("A7:D16")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F7:I16").Select
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Add
Key:=Range("H7:H16" _
), SortOn:=xlSortOnValues, Order:=xlAscending,
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Staff OT").Sort
.SetRange Range("F7:I16")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A24:D33").Select
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Add Key:=Range( _
"C24:C33"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Staff OT").Sort
.SetRange Range("A24:D33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F24:I33").Select
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Add Key:=Range( _
"H24:H33"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Staff OT").Sort
.SetRange Range("F24:I33")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A41:D50").Select
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Add Key:=Range( _
"C41:C50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Staff OT").Sort
.SetRange Range("A41:D50")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F41:I50").Select
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Staff OT").Sort.SortFields.Add Key:=Range( _
"H41:H50"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Staff OT").Sort
.SetRange Range("F41:I50")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End If
End If
If Target.Address = Range("L5:M6").Address Then
strPrompt = "Do you want to Reset the OT Sheet to Zero?"
intbuttons = vbYesNo + vbInformation
strTitle = "Galashiels Staff Overtime Rota © M Neil "
If MsgBox(strPrompt, intbuttons, strTitle) = vbYes Then
Range("B3:D3,B4,B5,C5:D5,C7:D16,C18:D18,G3:I3,G4,G 5,H5:I5,H7:I16,H18:I18,B20:D20,B21,B22,C22:D22,C24 :D33,C35:D35,G20:I20,G21,G22,H22:I22,H24:I33,H35:I 35").Select
Union(Range("G39,H39:I39,H41:I50,H52:I52,B3:D3,B4, B5,C5:D5,C7:D16,C18:D18,G3:I3,G4,G5,H5:I5,H7:I16,H 18:I18,B20:D20,B21,B22,C22:D22,C24:D33,C35:D35,G20 :I20,G21,G22,H22:I22,H24:I33,H35:I35,B37:D37,B38,B 39,C39:D39"),
Range("C41:D50,C52:D52,G37:I37,G38")).Select
Selection.ClearContents
ActiveSheet.Shapes("Check Box 1").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 2").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 3").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 4").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 5").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 6").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 7").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 8").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 9").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 10").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 11").Select
With Selection
.Value = xlOff
End With
ActiveSheet.Shapes("Check Box 12").Select
With Selection
.Value = xlOff
End With
Range("A7:B16,F7:G16,A24:B33,F24:G33").Select
Range("F24").Activate
Range("A7:B16,F7:G16,A24:B33,F24:G33,F41:G50,A41:B 50").Select
Range("A41").Activate
Selection.ClearContents
Range("O7:P16").Select
Selection.Copy
Range("A7:B7").Select
ActiveSheet.Paste
Range("Q7:R16").Select
Application.CutCopyMode = False
Selection.Copy
Range("F7:G7").Select
ActiveSheet.Paste
Range("O18:P27").Select
Application.CutCopyMode = False
Selection.Copy
Range("A24:B24").Select
ActiveSheet.Paste
Range("Q18:R27").Select
Application.CutCopyMode = False
Selection.Copy
Range("F24:G24").Select
ActiveSheet.Paste
Range("O29:P38").Select
Application.CutCopyMode = False
Selection.Copy
Range("A41:B41").Select
ActiveSheet.Paste
Range("Q29:R38").Select
Application.CutCopyMode = False
Selection.Copy
Range("F41:G41").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
MsgBox "You Must Now Save the File and click Yes 2 Times",
vbInformation, "Galashiels Staff Overtime Rota © M Neil "
End If
End If
End Sub
As you can see I had another range of cells to click to reset the data on
the sheet and copy some info from another part of the sheet, the code you
done for me was clearing the check boxes on sorting the names into order and
not by selecting the other cells.
Can you have a look at my code and see where it can be more efficient, I
know it could be more efficient but i'm only learning at the moment with VBA
and big learning curve.
Many thanks
Mark
|