Change sheet tab color automatically based on cell values

[user10]

Hi All! This is my first post - I am excited to be part of the community.
I have an Excel workbook in which I update values daily and if at anytime a zero value is entered in the values column, I would like the tab color for that sheet to turn red. I'd like to copy that code for all sheets in the workbook. I have been trying this code but can't get it to work:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Select Case Sheets.Range("$D").Value
         Case Is = 0
             Sheets.Tab.Color = vbRed
         End Select
End Sub

Any input you can provide would be greatly appreciated!!
Thanks!

[Paul_Hossler]

1. Welcome to the forum. Take a few minutes and read the FAQs at the link in my sig

2. I added CODE tags to your macro, you can use the [#] icon next time

3. You had a few errors

4. You didn't say what you want to do if the 0's are eventually replaced. Tab goes red with a 0 is entered, stays red for more 0's, but what happens when the 0's are all gone?

Try this

Option Explicit


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Application.WorksheetFunction.CountIf(Sh.Columns(4), 0) = 0 Then
        Sh.Tab.Color = vbGreen
    Else
        Sh.Tab.Color = vbRed
    End If
End Sub

[user10]

Thank you so much for the quick response Paul!
I have read the FAQ's thank you for pointing me to those.
If the 0's are eventually replaced by another value, the red tab would go away.
I added your code but am still doing something wrong apparently.
I've included a sample of my file with the code added.
For example, the "Roberts 1-3" worksheet has zero values and I would like that tab to be red.

Thank you again for all your help hopefully I can figure this out.

[Paul_Hossler]

I edited my first reply

I like Green

Try this

[user10]

Oh wow thank you that worked great!!

[Paul_Hossler]

Glad it worked for you

It can be made a little more robust and elegant

#3 in my sig explains how you can mark it [SOLVED]

Option Explicit


Const ColorNoZeros As Long = vbGreen
Const ColorSomeZeros As Long = vbRed


Private Sub Workbook_Open()
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each ws In ThisWorkbook.Worksheets
        Call pvtChangeTabColor(ws)
    Next


    Application.ScreenUpdating = True
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Call pvtChangeTabColor(Sh)
End Sub




Private Sub pvtChangeTabColor(ws As Worksheet)
    With ws
        If UCase(Trim(.Range("D1").Value)) <> "MCF" Then Exit Sub
            
        If Application.WorksheetFunction.CountIf(.Columns(4), 0) = 0 Then
            .Tab.Color = ColorNoZeros
        Else
            .Tab.Color = ColorSomeZeros
        End If
    End With
End Sub