Link to home
Start Free TrialLog in
Avatar of Jim Schwetz
Jim Schwetz

asked on

Excel WorkSheet Tab to change the color of the tab if any cell in the "B" Column is past due, or Red

Excel WorkSheet Tab to change the color of the tab to red if any cell in the "B" Column is past due, or Red.

I have a workbook full of tabs, but the report tab has a list of reports and the due dates on the reports. With conditional Formatting, the cell will turn red when due date is close, but Since I only visit the tab a few times a month, I want the tab to turn red when a task is coming up, so I remember to check it.

I have found this code on this site and modified it to what I thought would work:
Option Explicit

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If (Sh.Range("B2:B9").Interior.Color = RGB(255, 0, 0)) Then Sh.Tab.Color = vbRed
End Sub

Open in new window

And as you can probably see, the tab turned red, but will stay red even if nothing is past due.

I need the vba to check if any of the cells in range either 1: have a conditional formatting applied to the cell, or 2: test against the date in the cell.  past due or within 5 days should turn the tab red.

So the original code was set for the whole workbook, I only want it to work with one tab called "Reports"  and only 8 cells in column B.  (B2:B9).  Each of those cells has a data list(drop down list), so I can change the date once the task is done.

I tried "Function ActiveCondition" as well.  Not sure what the correct function would be to have the event triggered after click?
testTabColor.xlsm
Avatar of Rob Henson
Rob Henson
Flag of United Kingdom of Great Britain and Northern Ireland image

I am guessing you need an Else statement as well:

Option Explicit

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If (Sh.Range("B2:B9").Interior.Color = RGB(255, 0, 0)) Then
Sh.Tab.Color = vbRed
Else
Sh.Tab.Color = vbWhite
End If
End Sub

Open in new window

I would pop something like this into the workbook before save event:

So in the 'ThisWorkbook' module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

For Each sh In ThisWorkbook.Sheets
    
    f = False
    
    For Each c In sh.Range("B1:B9999").Cells
    
        If c.Interior.Color = RGB(255, 0, 0) Then f = True
    
        If IsDate(c) Then
            If c.Value < Date Then f = True
        End If
    
    Next c
    
    If f Then
        
        sh.Tab.Color = vbRed
    
    Else
        
        sh.Tab.ColorIndex = xlNone
        
    End If

Next sh

End Sub

Open in new window


This will color and un-color your sheets as you click save -so it is done as you close for when you re-open but wont effect you while you work.

You may also want to set it on open too... to check for date changes.

ATB
Steve.
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Jim Schwetz
Jim Schwetz

ASKER

Thanks for both of your fast replies,  Adding the Else statement did not work, so I tried the other comment, got an error, removed the date part, and still getting the error.  Thinking I declared them wrong?
Run-time error '438'  Object doesn't support this property or method  on yellow line in image
User generated image
Thanks Subodh Tiwari (Neeraj),
That worked perfect.  
Appreciate it.

And thanks both Rob and Steve, I learned new things trying out what you offered.
You're welcome Jim! Glad it worked as desired.
Thanks for the feedback.
As for the yellow line:

You have chart sheets in your workbook which do not have ranges like B1 to B9 so the object fails.

This code only checks 'normal' sheets...

Option Explicit


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sh, f, c
For Each sh In ThisWorkbook.Sheets
    
    f = False
    
    If sh.Type = -4167 Then
    
        For Each c In sh.Range("B1:B9").Cells
        
            
        
            If c.Interior.Color = RGB(255, 0, 0) Then f = True
        
            If IsDate(c) Then
                If c.Value < Date Then f = True
            End If
        
        Next c
        
        If f Then
            
            sh.Tab.Color = vbRed
        
        Else
            
            sh.Tab.ColorIndex = xlNone
            
        End If

    End If

Next sh

End Sub

Open in new window

Thanks Steve, so I only need to check the one sheet,  But I see why it was throwing the error now.  Not sure why the -4167, works, but good to know.  I will play with it.