Automate tab color changes for the whole workbook based on a cell in each sheet

ScareBear23

New Member
Joined
Dec 27, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I have a workbook that's currently a good 60-some sheets deep, and growing larger. Inside of each sheet is a different productivity tracker that has color coded values and I want the tab color to match the highest value on that sheet. I've just been manually changing each sheet to the color I want

I want a cell (C2) on each sheet to dictate the color change for the tab. I've gotten the code I want to work for a single sheet, but I want to apply it to the whole workbook so I don't need to manually add it to each current sheet & the sheets I'll be adding in the future.

This is the code that I currently have working on a single sheet. How can I make it work for all sheets? I'd class myself as fairly new to the more advanced features of Excel, so ELI5 would be greatly appreciated! Thank you!
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$C$2" Then
        Select Case Target.Value
        Case "y"
            Me.Tab.Color = vbYellow
        Case "o"
            Me.Tab.ColorIndex = 44
        Case "r"
            Me.Tab.Color = vbRed
        Case "d"
            Me.Tab.Color = RGB(192, 0, 0)
        Case "p"
            Me.Tab.Color = vbMagenta
        Case "pr"
            Me.Tab.Color = RGB(204, 0, 204)
        Case "g"
            Me.Tab.ColorIndex = 16
        Case "b"
            Me.Tab.Color = vbBlack
        End Select
    End If
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
To get your code to work in any sheet within the workbook, you need to add Private Sub Workbook_SheetChange code to the ThisWorkbook code window. Open the VBA editor & double-click on ThisWorkbook in the Project Explorer; copy the following code to the window that appears on the right. Save your file & test.

VBA Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Sh
        If Not Intersect(Target, Cells(2, 3)) Is Nothing Then
            Application.EnableEvents = False
            Select Case Target.Value
            Case "y"
                Sh.Tab.Color = vbYellow
            Case "o"
                Sh.Tab.ColorIndex = 44
            Case "r"
                Sh.Tab.Color = vbRed
            Case "d"
                Sh.Tab.Color = RGB(192, 0, 0)
            Case "p"
                Sh.Tab.Color = vbMagenta
            Case "pr"
                Sh.Tab.Color = RGB(204, 0, 204)
            Case "g"
                Sh.Tab.ColorIndex = 16
            Case "b"
                Sh.Tab.Color = vbBlack
            End Select
            Application.EnableEvents = True
        End If
    End With
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top