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
Jim SchwetzWeb SpecialistAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rob HensonFinance AnalystCommented:
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

0
SteveCommented:
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.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You can utilize the Workbook Open event to make the Reports Tab Red based on your conditional formatting rule for column B.

Place the following code on ThisWorkbook Module.
Private Sub Workbook_Open()
Dim ws As Worksheet
Dim lr As Long
Set ws = Sheets("Reports")
lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
If Evaluate("sumproduct((" & ws.Name & "!B2:B" & lr & "<=today())*(" & ws.Name & "!B2:B" & lr & ">=today()-6))") > 0 Then
    ws.Tab.ColorIndex = 3
Else
    ws.Tab.ColorIndex = xlColorIndexNone
End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Jim SchwetzWeb SpecialistAuthor Commented:
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
Run-time error '438'  Object doesn't support this property or method  on yellow line in image
0
Jim SchwetzWeb SpecialistAuthor Commented:
Thanks Subodh Tiwari (Neeraj),
That worked perfect.  
Appreciate it.

And thanks both Rob and Steve, I learned new things trying out what you offered.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Jim! Glad it worked as desired.
Thanks for the feedback.
0
SteveCommented:
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

0
Jim SchwetzWeb SpecialistAuthor Commented:
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.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.