Excel 2013, PC
I have a code that searches all the sheets in the workbook for Todays Date on opening the workbook.
Once found it will change that sheet’s tab colour.
My problem is on opening the workbook it activates the last sheet once it has change the sheet’s tab colour.
I have place an Exit For statement into the code to stop at the sheet with Today's Date, but problem still exist.
Any suggestions will be much appreciated
coxdw
Here is the code :-
Dim DateRng As Range
Dim DateCell As Range
Dim WorkSht As Worksheet
For Each WorkSht In Worksheets
WorkSht.Select
Set DateRng = Range("B12:E36")
For Each DateCell In DateRng
If DateCell.Value = Date Then
ActiveSheet.Tab.ColorIndex = 4
Exit For
End If
Next
Next WorkSht
End Sub
Might not be the prettiest possible code but should work:
Private Sub Workbook_Open() Dim DateRng As Range Dim c As Range Dim DateCell As Range Dim WorkSht As Worksheet On Error Resume Next For Each WorkSht In Worksheets With WorkSht Set DateRng = .Range("B12:E36") For Each c In DateRng If c.Value = Date Then Set DateCell = c Exit For End If Next If Not DateCell Is Nothing Then Set DateCell = Nothing .Tab.ColorIndex = 4 Else .Tab.Color = xlAutomatic End If End With Next WorkSht End Sub
Thanks for the Reply Misca
I entered your code and tested.
It found the sheet with Today’s Date and changed the tab’s colour that all worked.
Unfortunately it still activated the last sheet in the Workbook and not the Sheet with today’s date.
Just for clarification, there are 25 sheet in the work book and only one of those sheet will have Today's Date when the Workbook is open
Not sure if this is an issue, when I close the workbook the last sheet will be active as I have a code to remove sheet tab colour, which is only activated on WorkBook_BeforeClose() event.
Try this one. I've added a variable called "FoundWS". This captures the name of the worksheet that the date is found and activates it last.
Dim DateRng As Range
Dim c As Range
Dim DateCell As Range
Dim WorkSht As Worksheet
Dim FoundWS As String
On Error Resume Next
For Each WorkSht In Worksheets
With WorkSht
Debug.Print WorkSht.Name
Set DateRng = .Range("B12:E36")
For Each c In DateRng
If c.Value = Date Then
FoundWS = WorkSht.Name
Set DateCell = c
Exit For
End If
Next
If Not DateCell Is Nothing Then
Set DateCell = Nothing
.Tab.ColorIndex = 4
Else
.Tab.Color = xlAutomatic
End If
End With
Next WorkSht
Sheets(FoundWS).Activate
End Sub
Thanks Mike, that seems to have worked 🙂
