Changing worksheet tab colour by cell value

[Ld30]

Hello,

I have a spreadsheet going with several tabs and each tab represents 1 week. In each tab, I have a drop down column with 2 options: booked and tentative (in a given week, we can only book 5 events max). I currently have it set so that if it is tentative, the cell becomes red and if it is booked, the cell becomes green. I would also like to have the tab colour change with the following parameters: if all 5 dates are booked, the tab becomes green. If any of the 5 dates are tentative, the tab becomes red. Wondering if anyone can assist?

 

[Alex Blakenburg]

Try the below:
In the developer window double click on the relevant sheet in the project window on the left.
It should open a code window on the right.
Copy the code below into that window.

Since it is really hard to see the colour when the sheet is active I have opted to change the colour when you click off the sheet.
This will reduce how often the code has to run.

You will need to change the range to fit where you have your tentative / booked entries.

Option Explicit

Private Sub Worksheet_Deactivate()
    
    Dim cntBooked As Long
    Dim cntTentative As Long
    Dim rngStatus As Range
    
    Set rngStatus = Me.Range("B4:B8")  ' Change to range recording booked and tentative
    
    cntBooked = Application.CountIfs(rngStatus, "booked")
    cntTentative = Application.CountIfs(rngStatus, "tentative")
    
    If cntBooked = 5 Then
        With Me.Tab
            .Color = 255
        End With
    
    ElseIf cntTentative = 5 Then
        With Me.Tab
            .Color = 5296274
        End With
    Else
        With Me.Tab
            .Color = False
        End With
    End If

End Sub

 

[Ld30]

Thank

Try the below:
In the developer window double click on the relevant sheet in the project window on the left.
It should open a code window on the right.
Copy the code below into that window.

Since it is really hard to see the colour when the sheet is active I have opted to change the colour when you click off the sheet.
This will reduce how often the code has to run.

You will need to change the range to fit where you have your tentative / booked entries.

Option Explicit

Private Sub Worksheet_Deactivate()
   
    Dim cntBooked As Long
    Dim cntTentative As Long
    Dim rngStatus As Range
   
    Set rngStatus = Me.Range("B4:B8")  ' Change to range recording booked and tentative
   
    cntBooked = Application.CountIfs(rngStatus, "booked")
    cntTentative = Application.CountIfs(rngStatus, "tentative")
   
    If cntBooked = 5 Then
        With Me.Tab
            .Color = 255
        End With
   
    ElseIf cntTentative = 5 Then
        With Me.Tab
            .Color = 5296274
        End With
    Else
        With Me.Tab
            .Color = False
        End With
    End If

End Sub

Thank you so much for your response! It did work (just had to switch the colours around). The only other thing is that if there were any tentative selections at all (even just 1), we would want the tab to turn red. Is there a workaround for that?

 

[Alex Blakenburg]

if there were any tentative selections at all (even just 1), we would want the tab to turn red. Is there a workaround for that?

Just swap the if statement order around and make it >= 1 for tentative.
Here is the revised version.

Private Sub Worksheet_Deactivate()
    
    Dim cntBooked As Long
    Dim cntTentative As Long
    Dim rngStatus As Range
    
    Set rngStatus = Me.Range("B4:B8")  ' Change to range recording booked and tentative
    
    cntBooked = Application.CountIfs(rngStatus, "booked")
    cntTentative = Application.CountIfs(rngStatus, "tentative")
    
    If cntTentative >= 1 Then
        With Me.Tab
            .Color = 255
        End With
    
    ElseIf cntBooked = 5 Then
        With Me.Tab
            .Color = 5296274
        End With
    Else
        With Me.Tab
            .Color = False
        End With
    End If

End Sub

 

[Ld30]

Thank

Thank you so much for your response! It did work (just had to switch the colours around). The only other thing is that if there were any tentative selections at all (even just 1), we would want the tab to turn red. Is there a workaround for that?

Oh, haha I just figured it out. I removed the "=5" from this line "ElseIf cntTentative = 5 Then"

Thank you so much!

 

[Alex Blakenburg]

No problem. Glad I could help and thank you for letting me know/