Gasman
Enthusiastic Amateur
- Local time
- Today, 06:55
- Joined
- Sep 21, 2011
- Messages
- 16,281
I was wanting to create some appointments, that need to be the last Wednesday of every month in Outlook.
Rather than reinvent the wheel I went googling and found this piece of code.
As people are always asking for this sort of thing, I thought I would post it here. Link is in the code and any credits left well alone.?
I'd appreciate anyone using this code do the same?
Rather than reinvent the wheel I went googling and found this piece of code.
As people are always asking for this sort of thing, I thought I would post it here. Link is in the code and any credits left well alone.?
I'd appreciate anyone using this code do the same?
Code:
Public Function NthWeekday(Position, DayIndex As Long, TargetMonth As Long, Optional TargetYear As Long)
' Returns any arbitrary weekday (the "Nth" weekday) of a given month
' Position is the weekday's position in the month. Must be a number 1-5, or the letter L (last)
' DayIndex is weekday: 1=Sunday, 2=Monday, ..., 7=Saturday
' TargetMonth is the month the date is in: 1=Jan, 2=Feb, ..., 12=Dec
' If TargetYear is omitted, year for current system date/time is used
' This function as written supports Excel. To support Access, replace instances of
' CVErr(xlErrValue) with Null. To use with other VBA-supported applications or with VB,
' substitute a similar value
'From http://www.vbaexpress.com/kb/getarticle.php?kb_id=814
Dim FirstDate As Date
' Validate DayIndex
If DayIndex < 1 Or DayIndex > 7 Then
NthWeekday = Null ' CVErr(xlErrValue)
Exit Function
End If
If TargetYear = 0 Then TargetYear = Year(Now)
Select Case Position
'Validate Position
Case 1, 2, 3, 4, 5, "L", "l"
' Determine date for first of month
FirstDate = DateSerial(TargetYear, TargetMonth, 1)
' Find first instance of our targeted weekday in the month
If Weekday(FirstDate, vbSunday) < DayIndex Then
FirstDate = FirstDate + (DayIndex - Weekday(FirstDate, vbSunday))
ElseIf Weekday(FirstDate, vbSunday) > DayIndex Then
FirstDate = FirstDate + (DayIndex + 7 - Weekday(FirstDate, vbSunday))
End If
' Find the Nth instance. If Position is not numeric, then it must be "L" for last.
' In that case, loop to find last instance of the month (could be the 4th or the 5th)
If IsNumeric(Position) Then
NthWeekday = FirstDate + (Position - 1) * 7
If Month(NthWeekday) <> Month(FirstDate) Then NthWeekday = Null 'CVErr(xlErrValue)
Else
NthWeekday = FirstDate
Do Until Month(NthWeekday) <> Month(NthWeekday + 7)
NthWeekday = NthWeekday + 7
Loop
End If
' This only comes into play if the user supplied an invalid Position argument
Case Else
NthWeekday = Null 'CVErr(xlErrValue)
End Select
End Function
Last edited: