Code to Change Tab Color if Data Exists

Is there a code that will change the color of a tab if there is data on the worksheet?

There are a total of 12 tabs in the workbook. I need 8 of them (soon to be 7) to change color if there is data on them.

My best suggestion is to replicate the above code in each of the 8 (soon to be 7) sheets that you want to have the tab change color when data is added. You do not have to change the code except if you want the tabs to be different colors.

I experimented with using a Class to handle events from any sheet but have not gotten it to work yet. Because you only want some of the sheets to have that behavior, that would be a problematic solution anyway.

Originally Posted by JOHN H. DAVIS

This will remove the Tab Color as well and operates on all Sheets within the workbook.

Excellent suggestion, I had forgotten about that event!

The tab names I need excluded would be the below.

Client List
Combined
Correct File
Research

Originally Posted by JOHN H. DAVIS

Another option:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Sheet3" Then Exit Sub
If Sh.UsedRange < 1 Then Sh.Tab.ColorIndex = xlNone
If Not Intersect(Target, Sh.UsedRange) Is Nothing Then
    Sh.Tab.ColorIndex = 3
End If
End Sub

This will remove the Tab Color as well and operates on all Sheets within the workbook. If there are sheets you don't want included you need to place a line at the beginning. In the sample code above it excludes Sheet3

I hit Alt+F11 and put this code into a new module however it is not working.

Originally Posted by jscalem

I hit Alt+F11 and put this code into a new module however it is not working.

Hi,

This is a workbook event and has to be placed under "ThisWorkbook" module

I have modified the code provided by John to exclude the specified sheets.

Thanks

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'your exceptions
If Sh.Name = "Client List" _
    Or Sh.Name = "Combined" _
    Or Sh.Name = "Correct File" _
    Or Sh.Name = "Research" Then Exit Sub

If Sh.UsedRange < 1 Then Sh.Tab.ColorIndex = xlNone

If Not Intersect(Target, Sh.UsedRange) Is Nothing Then
    Sh.Tab.ColorIndex = 3
End If

End Sub

Originally Posted by 6StringJazzer

I am getting an error on this line if the sheet is not completely blank. Using UsedRange in a comparison is failing.

If Sh.UsedRange < 1 Then Sh.Tab.ColorIndex = xlNone

I was able to get this modification to work.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   'your exceptions
   If Sh.Name = "Client List" _
       Or Sh.Name = "Combined" _
       Or Sh.Name = "Correct File" _
       Or Sh.Name = "Research" Then Exit Sub
   
   If Sh.UsedRange.Count = 1 And Sh.UsedRange.Range("A1") = "" Then
      Sh.Tab.ColorIndex = xlNone
   Else
       Sh.Tab.ColorIndex = 3
   End If

End Sub

I just tested it and I dont get an error but the tab color does not change back to none. Its strange :?

maybe its time for me to close the application completely and delete temp files to clean Excel garbage

There are multiple solutions posted close together with multiple members offering commentary but we can't tell who is responding to what.

Let's wait for jscalem to review what's here and post back to tell us whether any of this is solving his problem.