Nth Xday in Month
James Fortune
For example, Thanksgiving Day is on the 4th Thursday in November. I
found the following functions useful in calculating the date of those
holidays. Note: you can also use them to calculate the Last Monday in
May (U.S. Memorial Day) by finding the 4th Monday in May and seeing if
adding 7 keeps the value at or under 31.
Example: Find day of Thanksgiving in 2007
MsgBox(NthXDayInMonthDayNumber(4, "Thursday", #11/1/07#))
returns: 22
'-----------------------------
Public Function NthXDayInMonthDayNumber(intN As Integer, strDay _
As String, dtTestDate As Date) As Integer
Dim intWNFDM As Integer 'holds Weekday Number of First Day _
in Month(dtTestDate)
Dim intXWeekdayNumber As Integer
Dim I As Integer
Select Case strDay
Case "Monday": intXWeekdayNumber = 1
Case "Tuesday": intXWeekdayNumber = 2
Case "Wednesday": intXWeekdayNumber = 3
Case "Thursday": intXWeekdayNumber = 4
Case "Friday": intXWeekdayNumber = 5
Case "Saturday": intXWeekdayNumber = 6
Case "Sunday": intXWeekdayNumber = 0
End Select
intWNFDM = GetWeekdayNumber(CDate(Month(dtTestDate) & "/1/" _
& Year(dtTestDate)))
For I = 0 To 6
If intWNFDM = (intXWeekdayNumber + I) Mod 7 Then Exit For
Next I
NthXDayInMonthDayNumber = (7 - I) Mod 7 + 1 + (intN - 1) * 7
End Function
Private Function GetWeekdayNumber(dtTestDate As Date) As Integer
Dim theDay As Integer
Dim theMonth As Integer
Dim theYear As Integer
Dim theCentury As Integer
Dim intDayNumber As Integer
'Use Zeller's Congruence to determine day of week (0 = Sunday)
theDay = Day(dtTestDate)
theMonth = (Month(dtTestDate) + 10) Mod 12
theYear = Year(dtTestDate) Mod 100
theCentury = Year(dtTestDate) \ 100
intDayNumber = theDay + Int((13 * theMonth - 2) / 5#) + theYear + _
(Int(theYear / 4#)) + Int(theCentury / 4#) - 2 * theCentury
intDayNumber = intDayNumber Mod 7
If intDayNumber < 0 Then intDayNumber = intDayNumber + 7
GetWeekdayNumber = intDayNumber
End Function
'-----------------------------
Also, putting a Select Case statement in the IsHoliday function keeps
Access from checking for holidays in months when they cannot occur.
Private Function IsHoliday(dtTestDate As Date, strFlag As String) _
As Boolean
'Sample strFlag = "11111111111" -- 1 = check that holiday, 0 = don't
check
IsHoliday = False
Select Case Month(dtTestDate)
Case 1:
If Mid(strFlag, 1) = 1 Then
If IsNewYears(dtTestDate) Then
IsHoliday = True
Exit Function
End If
End If
'...
Case 3, 4:
If Mid(strFlag, 4) = 1 Then
If IsEaster(dtTestDate) Then
IsHoliday = True
Exit Function
End If
End If
'...
I just have the IsEaster function to finish off the 11 holidays under
consideration.
James A. Fortune
James Fortune
> Several U.S. holidays are defined as the Nth Xday of a given month.
> For example, Thanksgiving Day is on the 4th Thursday in November. I
> found the following functions useful in calculating the date of those
> holidays. Note: you can also use them to calculate the Last Monday in
> May (U.S. Memorial Day) by finding the 4th Monday in May and seeing if
> adding 7 keeps the value at or under 31.
>
> Example: Find day of Thanksgiving in 2007
>
> MsgBox(NthXDayInMonthDayNumber(4, "Thursday", #11/1/07#))
>
> returns: 22
Starting with MGFoster's observation that VBA has a Weekday function
(I should have known about this since I posted code containing the
Weekday function once), I have modified the NthXDayInMonthDayNumber
function to the following:
Public Function NthXDayInMonthDayNumber(intN As Integer, intDay _
As Integer, dtTestDate As Date) As Integer
NthXDayInMonthDayNumber = (6 - WeekDay(CDate(Month(dtTestDate) & _
"/1/" & Year(dtTestDate)), vbMonday) + intDay) Mod 7 + 1 + _
(intN - 1) * 7
End Function
Example: NthXDayInMonthDayNumber(4, vbThursday, #11/1/04#) returns
25.
James A. Fortune
...send from a macro commandos to me... - From a Google Translation
MGFoster
Hash: SHA1
You could further simplify by using DateSerial() in place of the
conversion of the dtTestDate to a concatenated string then back to a
date. IOW, change this:
CDate(Month(dtTestDate) & "/1/" & Year(dtTestDate))
to this:
DateSerial(Year(dtTestDate), Month(dtTestDate), 1)
DateSerial() returns a Variant data type and CDate() returns a Date data
type. The Variant may slow down the function, but, I'm not sure if the
string to date conversion would be slower still. Testing would be
required.
--
MGFoster:::mgf00 <at> earthlink <decimal-point> net
Oakland, CA (USA)
-----BEGIN PGP SIGNATURE-----
Version: PGP for Personal Privacy 5.0
Charset: noconv
iQA/AwUBQX37SIechKqOuFEgEQLfQgCeIzEl/qddxJHjvdu8El3fTrpLHzEAn333
JWhtdo+Ibqqhpnr4DnGgPHeh
=qEkO
-----END PGP SIGNATURE-----
James Fortune
> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA1
>
> You could further simplify by using DateSerial() in place of the
> conversion of the dtTestDate to a concatenated string then back to a
> date. IOW, change this:
>
> CDate(Month(dtTestDate) & "/1/" & Year(dtTestDate))
>
> to this:
>
> DateSerial(Year(dtTestDate), Month(dtTestDate), 1)
>
> DateSerial() returns a Variant data type and CDate() returns a Date data
> type. The Variant may slow down the function, but, I'm not sure if the
> string to date conversion would be slower still. Testing would be
> required.
>
Incorporating MGFoster's latest suggestion (mostly because it saves a
character :-)):
Public Function NthXDay(N As Integer, D As Integer, dtD As Date) _
As Integer
NthXDay = (6 - WeekDay(DateSerial(Year(dtD), Month(dtD), 1), 2) _
+ D) Mod 7 + 1 + (N - 1) * 7
End Function
Example call:
Private Function IsMemorial(dtTestDate As Date) As Boolean
Dim intFinalMonday As Integer
'Last Monday in May
IsMemorial = False
If Month(dtTestDate) <> 5 Then Exit Function 'Not May
If Day(dtTestDate) < 25 Then Exit Function 'Same day follows in month
If WeekDay(dtTestDate) <> 2 Then Exit Function 'Not Monday
intFinalMonday = NthXDay(4, vbMonday, dtTestDate)
If intFinalMonday + 7 <= 31 Then intFinalMonday = intFinalMonday + 7
If intFinalMonday = Day(dtTestDate) Then IsMemorial = True
End Function
I can't really justify doing any speed testing between DateSerial and
CDate since even the version in the original post was already
sufficiently fast. Calculating the number of workdays for six months
accounting for holidays and optionally including Saturdays or Sundays
not falling on an included holiday took less than half a second. It's
really nice not having to maintain a holiday table.
James A. Fortune
Douglas J. Steele
news:a6ed3ce7.04102...@posting.google.com...
> MGFoster <m...@privacy.com> wrote in message
news:<PXmfd.7612$KJ6....@newsread1.news.pas.earthlink.net>...
> CDate since even the version in the original post was already
> sufficiently fast. Calculating the number of workdays for six months
> accounting for holidays and optionally including Saturdays or Sundays
> not falling on an included holiday took less than half a second. It's
> really nice not having to maintain a holiday table.
It doesn't really matter whether or not it's faster.
CDate(Month(dtTestDate) & "/1/" & Year(dtTestDate)) will fail on machines
where the Short Date setting is set to dd/mm/yyyy: it will return a date in
January in all cases. Therefore, for a universally useful solution,
DateSerial is the way to go.
--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)
James Fortune
> It doesn't really matter whether or not it's faster.
>
> CDate(Month(dtTestDate) & "/1/" & Year(dtTestDate)) will fail on machines
> where the Short Date setting is set to dd/mm/yyyy: it will return a date in
> January in all cases. Therefore, for a universally useful solution,
> DateSerial is the way to go.
Thanks. I was unaware of the Short Date setting situation. I was
even unaware that the Short Date setting could be changed. I'll have
to blame my Access for Dummies book for omitting that information.
I'll try to use DateSerial in the future when necessary. Is the
problem confined to converting date strings? I.e., should CDate never
be used?
James A. Fortune
Douglas J. Steele
Unlike most of the rest of Access, CDate will respect the user's ShortDate
format. That means it's probably safe to use it with a value the user has
keyed in. It's just not safe to assume a format using it.