Auto Open macro go to beginning of week

[Joseph Rosing]

I have a spreadsheet where I have people enter data each day. The
spreadsheet has each day in column B and the associated data for that
date in the adjacent columns. There is a macro so that the
spreadsheet automatically opens to today's date using the code below.

My question is, if I change the dates in column B to be the first day
of the week (using the Sunday standard) and have people enter data
once a week, how can I change the code below to find the date of the
first day of this week?

Thanks,
Joe

Macro code:

Sub Autpen()
'
' Autpen Macro

Dim FindString As Date
Dim Rng As Range
FindString = CLng(Date)
With Sheets("Sheet Name Here").Range("B:B")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Today's Date Not Found"
End If
End With
End Sub

 

[Bob Phillips]

FindString = CLng(Date - Weekday(Date) + 1)


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Joseph Rosing]

    FindString = CLng(Date - Weekday(Date) + 1)

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)









- Show quoted text -

Thanks for the reply. Now a slight change...

I want to input the data using Friday as the first day of the week. I
have changed the code to find Friday's date [FindString = CLng(Date -
Weekday(Date) + 6)] but if I open the spreadsheet on any day but
Friday it gives me the "Today's Date Not Found" message. How can I
script this so that it finds the date today (if today is Friday) or
the previous Friday?

Thanks for the help!

Here's the adapted code:

Sub Todays_Date()

Dim FindString As Date
Dim Rng As Range
FindString = CLng(Date - Weekday(Date) + 6)
With Sheets("Sheet Name Here").Range("C:C")
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Today's Date Not Found"
End If
End With

End Sub