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 :yes

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