Tab Color Dependent on Date

[default_name]

Hello!

I am new here, but I have a question regarding tab colors.

I have a workbook that is split up into pay periods for a record of timekeeping.
Each pay period is represented on an individual tab (there are several tabs in the workbook [the workbook contains pay periods for the entire year]).

I am trying to write a macro that would automatically highlight the worksheet tab (or change the tab color to something like yellow) that corresponds to the current pay period.

Dates for each day in the pay period are displayed in the following cells of each worksheet:

D1:H1
D19:H19

​

Basically, I want the tab to highlight based on the current date so it is easier to see which tab/pay period I should be on.


Not sure if my question is making sense...

ie: If today's date is 5/16/18 (which it is), then the worksheet in the workbook where 5/16/18 is found in one of those cells (D1:H1 or D19:H19) should have a yellow tab.
​

I am not so sure I am writing the macro correctly.
Here is what I have so far:

Private Sub Worksheet_Calculate()

    If Range("D1:H1","D19:H19").Value = "Today()" Then
        Me.Tab.ColorIndex = 6   ' Yellow
    Else
        Me.Tab.ColorIndex = -4142       ' No Color
    End If
    
End Sub

Thanks in advance!

 

[Fluff]

How about

Private Sub Workbook_Open()
   Dim Ws As Worksheet
   Dim Fnd As Range
   For Each Ws In Worksheets
      Set Fnd = Ws.Range("D1:H1,D19:H19").Find(Date, , , , , , , , False)
      Ws.Tab.Color = IIf(Fnd Is Nothing, False, vbYellow)
   Next Ws
End Sub

This needs to go in the ThisWorkbook module

 

[mumps]

Place this macro in the code module for ThisWorkbook. Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the left hand pane, double click on "ThisWorkbook". Copy/paste the macro into the empty window that opens up. Close the window to return to your sheet. Save the workbook as a macro-enabled file and close it. When you re-open it the appropriate tab will be yellow.

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim foundDate As Range
    Dim DateRng As Range
    For Each ws In Sheets
        Set DateRng = ws.Range("D1:H1,D19:H19")
        Set foundDate = DateRng.Find(Date, LookIn:=xlFormulas, lookat:=xlWhole)
        If Not foundDate Is Nothing Then
            ws.Tab.Color = vbYellow
        End If
    Next ws
End Sub

 

[JoeMo]

Problem with workbook_open event is that the workbook may be left open indefinitely so the code executes once and by the next day the tab may not have the desired color. Worksheet_Calculate can also be problematic if there's no activity on the sheet to trigger calculation, but since the OP uses that event, here's some code that should work when the sheet is calculated.

Private Sub Worksheet_Calculate()
Dim x As Range
On Error Resume Next
Set x = Me.Range("D1:H1,D19:H19").Find(Date, LookIn:=xlValues)
If x Is Nothing Then
    Me.Tab.ColorIndex = -4142       ' No Color
Else
    Me.Tab.ColorIndex = 6   ' Yellow
End If
End Sub

 

[Fluff]

Problem with workbook_open event is that the workbook may be left open indefinitely so the code executes once and by the next day the tab may not have the desired color.

Excellent point

 

[default_name]

Problem with workbook_open event is that the workbook may be left open indefinitely so the code executes once and by the next day the tab may not have the desired color. Worksheet_Calculate can also be problematic if there's no activity on the sheet to trigger calculation, but since the OP uses that event, here's some code that should work when the sheet is calculated.

Private Sub Worksheet_Calculate()
Dim x As Range
On Error Resume Next
Set x = Me.Range("D1:H1,D19:H19").Find(Date, LookIn:=xlValues)
If x Is Nothing Then
    Me.Tab.ColorIndex = -4142       ' No Color
Else
    Me.Tab.ColorIndex = 6   ' Yellow
End If
End Sub

Wow, you guys are quick with responses!

I pasted your code into the ThisWorkbook code box.
I saved it as a macro-enabled file and closed it.
I reopened the file. Nothing happens.

I also checked the Developer>Macro Security options to make sure that all macros are enabled.
What am I missing/doing wrong?

Thanks again for your help!

 

[shg]

If you do that in the Calculate event as coded, it kills Undo.

 

[Fluff]

Wow, you guys are quick with responses!

I pasted your code into the ThisWorkbook code box.
I saved it as a macro-enabled file and closed it.
I reopened the file. Nothing happens.

I also checked the Developer>Macro Security options to make sure that all macros are enabled.
What am I missing/doing wrong?

Thanks again for your help!

That code will need to go in the sheet module (for each sheet) rather than the ThisWorkbook module.
But take note of what shg has said in post#7

 

[default_name]

Thanks guys!!

 

[Fluff]

Glad we could help & thanks for the feedback