VBA 2 Codes

T

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("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
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("B3:D3,B4,B5,C5:D5,C7:D16,C18:D18,G3:I3,G4,G5,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:I35" _
).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,H18:I18,B20:D20,B21,B22,C22:D22,C24:D33,C35:D35,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35,B37:D37,B38,B39,C39:D39" _
), Range("C41:D50,C52:D52,G37:I37,G38")).Select
Selection.ClearContents
Range("A1").Select
End Sub

Many thanks for your help.

Mark
 
J

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("B3:D3,B4,B5,C5:D5,C7:D16,C18:D18,G3:I3,G4,G5,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:I35"
_
).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,H18:I18,B20:D20,B21,B22,C22:D22,C24:D33,C35:D35,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35,B37:D37,B38,B39,C39:D39"
_
), Range("C41:D50,C52:D52,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.
 
T

terilad

Many thanks

Mark

JLGWhiz said:
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("B3:D3,B4,B5,C5:D5,C7:D16,C18:D18,G3:I3,G4,G5,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:I35"
_
).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,H18:I18,B20:D20,B21,B22,C22:D22,C24:D33,C35:D35,G20:I20,G21,G22,H22:I22,H24:I33,H35:I35,B37:D37,B38,B39,C39:D39"
_
), Range("C41:D50,C52:D52,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.




.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Undo Macro Action 3
Clear Check Box 2
VBA 4
Modify Sort Routine to inlcude All Data 2
Sorting Question 5
Sort by one column then another. 2
vba dynamic 1
Pictures not being sorted in VBA 2

Top