Solved: Open workbook to last Friday of current week

[Dave T]

Hello All,

I have a workbook with several worksheets I use for recording my daily working hours.

The worksheet tabs are labelled “2010 Timesheet”, “2011 Timesheet”, etc.
I also use a worksheet called “Date & Time Ranges” which contains dates of public holidays etc. and may contain a date which is the last Friday of the current week.

I would like a Workbook_Open macro to search through all of the worksheets and find / select and then highlight the next Friday after today’s date, without checking the “Date & Time Ranges” worksheet.

I have cells where I have identified the last Friday of each week but these cells range from D10, F10, H10, J10 in various rows all the way down to cell J160 (otherwise last Friday date is never repeated).
NOTE: The only dates on each ‘Timesheet’ worksheet are week ending Friday dates; there are no other dates listed between these dates.

I have found various macros that will search a specific column and select today’s date on a specific sheet or just within sheet(1), but have been unable to find something that will search various worksheets and within a range of cells.

Any help would be appreciated.

Regards,
Dave T

[fmcti]

Don't you have a sample file?

[Dave T]

Hello fmcti,

Within the workbook I have some code which would go to today's date.
But if today's date is no there nothing happens.
Also the sheet with today's date must be the first sheet on the left of all tabs.

I would like to macro to find the next Friday after today's date without having to sort the tab order.

Regards,
Dave T

[mancubus]

assuming there is only 1 occurence of a date, is it?

credits: ozgrid


Sub FindNextFri()

Dim wks As Worksheet
Dim fDate As Date
Dim fCell As Range

Select Case DatePart("w", Date, vbMonday) ' 1=Mon / 7=Sun
Case 1: fDate = Date + 4
Case 2: fDate = Date + 3
Case 3: fDate = Date + 2
Case 4: fDate = Date + 1
Case 5: fDate = Date + 0
Case 6: fDate = Date + 5
Case 7: fDate = Date + 6
End Select
fDate = CLng(fDate)
For Each wks In ActiveWorkbook.Worksheets
wks.Select
Set fCell = Cells.Find(What:=fDate)
Next
If Not fCell Is Nothing Then
Application.Goto fCell
Else
MsgBox "Not Found"
End If
End Sub

[fmcti]

The code above seems to not work on my computer. While I change to cell to cell comparation, it works.
The find function does not work on cells that reference to other cells.

Sub FindNextFri1()

Dim wks As Worksheet
Dim fDate As String
Dim fCell As Range
Dim fRange As Range

Select Case DatePart("w", Date, vbMonday) ' 1=Mon / 7=Sun
Case 1: fDate = Date + 4
Case 2: fDate = Date + 3
Case 3: fDate = Date + 2
Case 4: fDate = Date + 1
Case 5: fDate = Date + 0
Case 6: fDate = Date + 5
Case 7: fDate = Date + 6
End Select
'fDate = CLng(fDate)
For Each wks In ActiveWorkbook.Worksheets
For Each fRange In wks.UsedRange
If fRange = fDate Then
Set fCell = fRange
End If
Next
Next
If Not fCell Is Nothing Then
Application.Goto fCell
Else
MsgBox "Not Found"
End If
End Sub

[mdmackillop]

Give this a try. The Column width reset is needed for the Find function to work.

Option Explicit
Sub FindNextFri()
Dim wks As Worksheet
Dim fCell As Range
Dim d As Long
Dim dt As String
d = Date + 6 - (Date Mod 7)
dt = Format(d, "(ddd) dd-mmm-yyyy")
For Each wks In ActiveWorkbook.Worksheets
If Left(wks.Name, 4) <> "Date" Then
wks.Columns("D:K").ColumnWidth = 20
Set fCell = wks.Cells.Find(dt, LookIn:=xlValues)
If Not fCell Is Nothing Then
fCell.Offset(6).Interior.ColorIndex = 6
Application.Goto fCell.Offset(6)
End If
wks.Columns("D:K").ColumnWidth = 11
End If
Next
End Sub

[mancubus]

If Left(wks.Name, 4) <> Year(Date) Then


thanks for the code.
after correcting typo, perfect.

[mdmackillop]

Typo?

without checking the “Date & Time Ranges” worksheet.

[mancubus]

sheet names which start with years, i thought it was... :whistle:

but seeing now the worksheet named "Date..."

what a shame... :mkay

[Dave T]

Hello mancubus, fmcti and mdmackillop,

Wow... the number of replies is amazing.

Thank you all for your comments and especially the little extra comments between yourselves about what was need to solve this. For someone like me who is trying to get their head around VBA these are very usefull.

To get the workbook to open with the specified cell visible I added an extra line:

Application.Goto fCell, scroll:=True

Once again, a big thank you to all of you for your contributions.

Regards,
Dave T

[fmcti]

Hello mdmackillop, why reseting columns width would allow the find function to work? It seems so irrelevant, while it does work.