Allow macro to run on multiple sheets in same workbook

MWeber2222 · Oct 15, 2015

Hi,

I developed the following macro(s) to run on a single worksheet whenever the user makes a change to specific fields. Now the user wants to have the macros run on multiple instances of the worksheet within the same workbook. Any idea how I need to modify the code in order to do this?

I have attached the file and code for your review. I appreciate any help that may be offered.

Thanks!

Mike W.

Code:

____________________________________________
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("C7:C9")) Is Nothing Then
        Call LightColors
        Call LightColorsTotal
    ElseIf Not Intersect(Target, Range("G7:G8")) Is Nothing Then
        Call LightColorsDevice
        Call LightColorsTotal
    ElseIf Not Intersect(Target, Range("K7:K9")) Is Nothing Then
        Call LightColorsAccount
        Call LightColorsTotal
    ElseIf Not Intersect(Target, Range("O7:O8")) Is Nothing Then
        Call LightColorsFinancial
        Call LightColorsTotal
 
    End If

End Sub
____________________________________________


Sub LightColors()

Application.Volatile

    'Unprotect sheet
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
    Application.Calculation = xlCalculationAutomatic
    ActiveSheet.Shapes("Rectangle1").Visible = False
    ActiveSheet.Range("B18:C32").Borders.LineStyle = xlNone
    ActiveSheet.Protect Password:="xpsibpt-2015-public"

' Client Light
    Dim rng As Range
    Dim ShapeName As String
    Dim SHP As Shape

' Define shape and range information

    ShapeName = "Oval 1"
    Set rng = ThisWorkbook.Worksheets("Trainee Rating").Range("MergeRange1")
    Set SHP = rng.Parent.Shapes(ShapeName)
 
' Assign shape colors

    ' Gray
    If rng.Text = "#N/A" Then
    SHP.Fill.ForeColor.RGB = RGB(217, 217, 217)
    Exit Sub
    End If
 
    ' Green
    If rng.Value >= 80 Then
    SHP.Fill.ForeColor.RGB = RGB(157, 207, 119)
    End If
 
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
 
    ' Yellow
    If rng.Value >= 55 And rng.Value < 80 Then
    SHP.Fill.ForeColor.RGB = RGB(254, 225, 80)
    'Note box
    ActiveSheet.Shapes("Rectangle1").Visible = True
    Range("B18:C32").BorderAround Weight:=xlThin
    ActiveSheet.Range("B18:C32").Locked = False
    Else
    ActiveSheet.Range("B18:C32").Borders.LineStyle = xlNone
 
    End If
 
    ' Red
    If rng.Value < 55 And rng.Value > 0 Then
    SHP.Fill.ForeColor.RGB = RGB(233, 126, 123)
    'Note box
    ActiveSheet.Shapes("Rectangle1").Visible = True
    Range("B18:C32").BorderAround Weight:=xlThin
    ActiveSheet.Range("B18:C32").Locked = False
    End If
 
    ActiveSheet.Protect Password:="xpsibpt-2015-public"
 
End Sub
____________________________________________


Sub LightColorsDevice()

Application.Volatile

    'Unprotect sheet
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
    Application.Calculation = xlCalculationAutomatic
    ActiveSheet.Shapes("Rectangle2").Visible = False
    ActiveSheet.Range("F18:G32").Borders.LineStyle = xlNone
    ActiveSheet.Protect Password:="xpsibpt-2015-public"

' Client Light
    Dim rng As Range
    Dim ShapeName As String
    Dim SHP As Shape

' Define shape and range information

    ShapeName = "Oval 2"
    Set rng = ThisWorkbook.Worksheets("Trainee Rating").Range("MergeRange2")
    Set SHP = rng.Parent.Shapes(ShapeName)
 
' Assign shape colors

    ' Gray
    If rng.Text = "#N/A" Then
    SHP.Fill.ForeColor.RGB = RGB(217, 217, 217)
    Exit Sub
    End If
 
    ' Green
    If rng.Value >= 80 Then
    SHP.Fill.ForeColor.RGB = RGB(157, 207, 119)
    End If
   
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
   
    ' Yellow
    If rng.Value >= 55 And rng.Value < 80 Then
    SHP.Fill.ForeColor.RGB = RGB(254, 225, 80)
    'Note box
    ActiveSheet.Shapes("Rectangle2").Visible = True
    Range("F18:G32").BorderAround Weight:=xlThin
    ActiveSheet.Range("F18:G32").Locked = False
    Else
    ActiveSheet.Range("F18:G32").Borders.LineStyle = xlNone
    End If
 
    ' Red
    If rng.Value < 55 And rng.Value > 0 Then
    SHP.Fill.ForeColor.RGB = RGB(233, 126, 123)
    'Note box
    ActiveSheet.Shapes("Rectangle2").Visible = True
    Range("F18:G32").BorderAround Weight:=xlThin
    ActiveSheet.Range("F18:G32").Locked = False
    End If
 
    ActiveSheet.Protect Password:="xpsibpt-2015-public"
 
End Sub
____________________________________________

Sub LightColorsAccount()

Application.Volatile

    'Unprotect sheet
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
    Application.Calculation = xlCalculationAutomatic
    ActiveSheet.Shapes("Rectangle3").Visible = False
    ActiveSheet.Range("J18:K32").Borders.LineStyle = xlNone
    ActiveSheet.Protect Password:="xpsibpt-2015-public"

' Client Light
    Dim rng As Range
    Dim ShapeName As String
    Dim SHP As Shape

' Define shape and range information

    ShapeName = "Oval 3"
    Set rng = ThisWorkbook.Worksheets("Trainee Rating").Range("MergeRange3")
    Set SHP = rng.Parent.Shapes(ShapeName)
 
' Assign shape colors

    ' Gray
    If rng.Text = "#N/A" Then
    SHP.Fill.ForeColor.RGB = RGB(217, 217, 217)
    Exit Sub
    End If
 
    ' Green
    If rng.Value >= 80 Then
    SHP.Fill.ForeColor.RGB = RGB(157, 207, 119)
    End If
   
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
       
    ' Yellow
    If rng.Value >= 55 And rng.Value < 80 Then
    SHP.Fill.ForeColor.RGB = RGB(254, 225, 80)
    'Note box
    ActiveSheet.Shapes("Rectangle3").Visible = True
    Range("J18:K32").BorderAround Weight:=xlThin
    ActiveSheet.Range("J18:K32").Locked = False
    Else
    ActiveSheet.Range("J18:K32").Borders.LineStyle = xlNone
    End If
 
    ' Red
    If rng.Value < 55 And rng.Value > 0 Then
    SHP.Fill.ForeColor.RGB = RGB(233, 126, 123)
    'Note box
    ActiveSheet.Shapes("Rectangle3").Visible = True
    Range("J18:K32").BorderAround Weight:=xlThin
    ActiveSheet.Range("J18:K32").Locked = False
    End If
 
    ActiveSheet.Protect Password:="xpsibpt-2015-public"
 
End Sub
____________________________________________

Sub LightColorsFinancial()

Application.Volatile

    'Unprotect sheet
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
    Application.Calculation = xlCalculationAutomatic
    ActiveSheet.Shapes("Rectangle4").Visible = False
    ActiveSheet.Range("N18:O32").Borders.LineStyle = xlNone
    ActiveSheet.Protect Password:="xpsibpt-2015-public"

' Client Light
    Dim rng As Range
    Dim ShapeName As String
    Dim ShapeName4 As String
    Dim SHP As Shape

' Define shape and range information

    ShapeName = "Oval 4"
    Set rng = ThisWorkbook.Worksheets("Trainee Rating").Range("MergeRange4")
    Set SHP = rng.Parent.Shapes(ShapeName)
 
' Assign shape colors

    ' Gray
    If rng.Text = "#N/A" Then
    SHP.Fill.ForeColor.RGB = RGB(217, 217, 217)
    Exit Sub
    End If
 
    ' Green
    If rng.Value >= 80 Then
    SHP.Fill.ForeColor.RGB = RGB(157, 207, 119)
    End If
   
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"
           
    ' Yellow
    If rng.Value >= 55 And rng.Value < 80 Then
    SHP.Fill.ForeColor.RGB = RGB(254, 225, 80)
    'Note box
    ActiveSheet.Shapes("Rectangle4").Visible = True
    Range("N18:O32").BorderAround Weight:=xlThin
    ActiveSheet.Range("N18:O32").Locked = False
    Else
    ActiveSheet.Range("N18:O32").Borders.LineStyle = xlNone
    End If
 
    ' Red
    If rng.Value < 55 And rng.Value > 0 Then
    SHP.Fill.ForeColor.RGB = RGB(233, 126, 123)
    'Note box
    ActiveSheet.Shapes("Rectangle4").Visible = True
    Range("N18:O32").BorderAround Weight:=xlThin
    ActiveSheet.Range("N18:O32").Locked = False
    End If
 
    ActiveSheet.Protect Password:="xpsibpt-2015-public"
 
End Sub
____________________________________________

Sub LightColorsTotal()

Application.Calculation = xlCalculationAutomatic

Application.Volatile

' Client Light
    Dim rng As Range
    Dim ShapeName As String
    Dim SHP As Shape

' Define shape and range information

    ShapeName = "Oval 5"
    Set rng = ThisWorkbook.Worksheets("Trainee Rating").Range("MergeRange5")
    Set SHP = rng.Parent.Shapes(ShapeName)
 
' Assign shape colors

    ' Gray
    If rng.Text = "#N/A" Then
    SHP.Fill.ForeColor.RGB = RGB(217, 217, 217)
    Exit Sub
    End If
 
    ' Green
    If rng.Value >= 80 Then
    SHP.Fill.ForeColor.RGB = RGB(157, 207, 119)
    End If
 
    ' Yellow
    If rng.Value >= 55 And rng.Value < 80 Then
    SHP.Fill.ForeColor.RGB = RGB(254, 225, 80)
    End If
 
    ' Red
    If rng.Value < 55 And rng.Value > 0 Then
    SHP.Fill.ForeColor.RGB = RGB(233, 126, 123)
    End If

End Sub
____________________________________________

Sub ResetSheet()

'Unprotect Data Sheet
    ActiveSheet.Unprotect Password:="xpsibpt-2015-public"

' Clear PullDowns
    Sheets("Trainee Rating").Range("C7:C9").ClearContents
    Sheets("Trainee Rating").Range("G7:G8").ClearContents
    Sheets("Trainee Rating").Range("K7:K9").ClearContents
    Sheets("Trainee Rating").Range("O7:O8").ClearContents
 
' Clear Data
    Sheets("Trainee Rating").Range("J3:K3").ClearContents
    Sheets("Trainee Rating").Range("N3:O3").ClearContents
    Sheets("Trainee Rating").Range("R3:S3").ClearContents
 
'Clear Notes
    Sheets("Trainee Rating").Unprotect Password:="xpsibpt-2015-public"
    Sheets("Trainee Rating").Range("B18:C32").ClearContents
    Sheets("Trainee Rating").Range("F18:G32").ClearContents
    Sheets("Trainee Rating").Range("J18:K32").ClearContents
    Sheets("Trainee Rating").Range("N18:O32").ClearContents

'Protect Data Sheet
    ActiveSheet.Range("B18:C32").Locked = True
    ActiveSheet.Range("F18:G32").Locked = True
    ActiveSheet.Range("J18:K32").Locked = True
    ActiveSheet.Range("N18:O32").Locked = True
 
    ActiveSheet.Protect Password:="xpsibpt-2015-public"
   
End Sub

vletm · Oct 15, 2015

It was protected one sheet Workbook ( and I didn't open it ),
so only basic sample for You
( like change fixed sheetname to a_tab ).
Ideas?

MWeber2222 · Oct 15, 2015

My apologies. I have attached the file again without VBA protection. The password to unlock the worksheet protection is included in the code, if needed.

Thanks!

vletm · Oct 15, 2015

If You mean 'only' to copy 'Trainee Rating'-tab
(different tab-name are okay) many times ...
This version could work ... if all 'Shape'-names will be same in every tab.
... and if many user want to use same file same time, it could be challenge.
Did You mean something like this?

Nebu · Oct 16, 2015

Hi:
A completely unrelated one, why are you using Application.volatile in a subroutine, it basically has no effect unless you are using it in a UDF.

https://msdn.microsoft.com/en-us/library/office/ff195441.aspx

Thanks

MWeber2222 · Oct 19, 2015

vletm said:
If You mean 'only' to copy 'Trainee Rating'-tab
(different tab-name are okay) many times ...
This version could work ... if all 'Shape'-names will be same in every tab.
... and if many user want to use same file same time, it could be challenge.
Did You mean something like this?

That worked perfectly! Thank you so much for the help!

Regards,
Mike W.

MWeber2222 · Oct 19, 2015

Nebu said:
Hi:
A completely unrelated one, why are you using Application.volatile in a subroutine, it basically has no effect unless you are using it in a UDF.

https://msdn.microsoft.com/en-us/library/office/ff195441.aspx

Thanks

I tried a lot of different things before I got this to work. That was just a "leftover". Thanks for pointing it out. I removed it from the code and all still works as intended.

Regards,
Mike W.

Allow macro to run on multiple sheets in same workbook

MWeber2222

New Member

Attachments

vletm

Excel Ninja

Attachments

MWeber2222

New Member

Attachments

vletm

Excel Ninja

Attachments

Nebu

Excel Ninja

MWeber2222

New Member

MWeber2222

New Member