VBA 2 Codes

[terilad]

Hi I have 2 VBA codes and I want them to run but I cant have 2 Private Sub
Worksheet_SelectionChange(ByVal Target As Range) so how can I have these 2
codes on the same sheet and run on a click of the cell?

The codes are:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strPrompt As String
Dim intbuttons As Integer
Dim strTitle As String
If Target.Address = Range("K2").Address Then
strPrompt = "Do you want Put Staff into OT Order?"
intbuttons = vbYesNo + vbInformation
strTitle = "Galashiels Operational Resources © MN "
If MsgBox(strPrompt, intbuttons, strTitle) = vbYes Then
Range("A716").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("A716")
.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("A2433").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("A2433")
.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("A4150").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("A4150")
.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
End Sub

AND

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strPrompt As String
Dim intbuttons As Integer
Dim strTitle As String
If Target.Address = Range("K4").Address Then
strPrompt = "Do you want to Reset the OT List to Zero?"
intbuttons = vbYesNo + vbInformation
strTitle = "Galashiels Operational Resources © MN "
If MsgBox(strPrompt, intbuttons, strTitle) = vbYes Then

Range("B33,B4,B5,C55,C716,C1818,G3:I3,G4,G5,H5:I5,H7:I16,H18:I18,B2020,B21,B22,C2222,C2433,C3535,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35" _
).Select

Union(Range("G39,H39:I39,H41:I50,H52:I52,B33,B4,B5,C55,C716,C1818,G3:I3,G4,G5,H5:I5,H7:I16,H18:I18,B2020,B21,B22,C2222,C2433,C3535,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35,B3737,B38,B39,C3939" _
), Range("C4150,C5252,G37:I37,G38")).Select
Selection.ClearContents
Range("A1").Select
End Sub

Many thanks for your help.

Mark

 

[JLGWhiz]

You already have the code written, you just need to put this part of the
second macro, after the second End If in the first macro:

If Target.Address = Range("K4").Address Then
strPrompt = "Do you want to Reset the OT List to Zero?"
intbuttons = vbYesNo + vbInformation
strTitle = "Galashiels Operational Resources © MN "
If MsgBox(strPrompt, intbuttons, strTitle) = vbYes Then

Range("B33,B4,B5,C55,C716,C1818,G3:I3,G4,G5,H5:I5,H7:I16,H18:I18,B2020,B21,B22,C2222,C2433,C3535,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35"
_
).Select

Union(Range("G39,H39:I39,H41:I50,H52:I52,B33,B4,B5,C55,C716,C1818,G3:I3,G4,G5,H5:I5,H7:I16,H18:I18,B2020,B21,B22,C2222,C2433,C3535,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35,B3737,B38,B39,C3939"
_
), Range("C4150,C5252,G37:I37,G38")).Select
Selection.ClearContents
Range("A1").Select
End If
End If

The If statements allow only the part where the criteria is true to run.

 

[terilad]

Many thanks

Mark

You already have the code written, you just need to put this part of the
second macro, after the second End If in the first macro:

If Target.Address = Range("K4").Address Then
strPrompt = "Do you want to Reset the OT List to Zero?"
intbuttons = vbYesNo + vbInformation
strTitle = "Galashiels Operational Resources © MN "
If MsgBox(strPrompt, intbuttons, strTitle) = vbYes Then

Range("B33,B4,B5,C55,C716,C1818,G3:I3,G4,G5,H5:I5,H7:I16,H18:I18,B2020,B21,B22,C2222,C2433,C3535,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35"
_
).Select

Union(Range("G39,H39:I39,H41:I50,H52:I52,B33,B4,B5,C55,C716,C1818,G3:I3,G4,G5,H5:I5,H7:I16,H18:I18,B2020,B21,B22,C2222,C2433,C3535,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35,B3737,B38,B39,C3939"
_
), Range("C4150,C5252,G37:I37,G38")).Select
Selection.ClearContents
Range("A1").Select
End If
End If

The If statements allow only the part where the criteria is true to run.




.