Greetings Access Gurus! I am working on an app to send batch
transactions to our bank, and the bank requires that we place an
effective date on our files that is 'one business day in the future,
excluding holidays and weekends.' I didn't want to build a table of
holidays that would have to be continuously updated, so I searched high
and low for a function that would tell me whether a given date was a
holiday, to no avail. I did find an article that showed how to build a
table of holidays for a given year and add them to a table at
http://www.tek-tips.com/faqs.cfm?fid=6003, so I adapted the code to my
own needs and thought I would share. My calling statement is at the
bottom of my code. After considerable testing, it seems to be working
properly, but would love to know if anyone sees any potential pitfalls
in my solution.
I discovered there are 10 Federal Holidays that banks are closed on,
and that if the holiday falls on a weekend date, they close on the
following Monday. Here's my full code. Please let me know if you see
anything that could bite me in the arse later!
Option Compare Database
Option Explicit
Public Function isHoliday(dtEffDate As Date) As Boolean
'================================================= ================
'This function programmatically determines whether or not a given
'date is a Federal Holiday
'Written by Jana Bauer, adapted from code obtained at
'http://www.tek-tips.com/faqs.cfm?fid=6003
'================================================= ================
On Error GoTo ErrHandler
Dim dtHoliday As Date
Dim intWeekday As Integer
Dim intMondayCount As Integer
Dim intThursdayCount As Integer
Dim lngDay As Long
isHoliday = False
Select Case Month(dtEffDate)
Case 3, 4, 6, 8 'No holidays in these months
Exit Function
Case 1 'Check for January Holidays
'Determine New Year's Day
'1/1 or Following Monday
dtHoliday = CDate("1/1/" & CStr(Year(dtEffDate)))
dtHoliday = GetFollowingMonday(dtHoliday)
If dtEffDate = dtHoliday Then
isHoliday = True
Exit Function
End If
'Determine MLK Day
'3rd Monday in January
dtHoliday = CDate("1/1/" & CStr(Year(dtEffDate)))
For lngDay = 0 To 30
intWeekday = WeekDay(dtHoliday + lngDay)
If intWeekday = vbMonday Then
dtHoliday = dtHoliday + lngDay + 14
Exit For
End If
Next lngDay
If dtEffDate = dtHoliday Then isHoliday = True
Case 2 'Check for February Holiday
'Determine President's Day
'3rd Monday in February
dtHoliday = CDate("2/1/" & CStr(Year(dtEffDate)))
For lngDay = 0 To 27
intWeekday = WeekDay(dtHoliday + lngDay)
If intWeekday = vbMonday Then
dtHoliday = dtHoliday + lngDay + 14
Exit For
End If
Next lngDay
If dtEffDate = dtHoliday Then isHoliday = True
Case 5 'Check for May Holiday
'Determine Memorial Day
'Last Monday in May
dtHoliday = CDate("5/31/" & CStr(Year(dtEffDate)))
For lngDay = 0 To 30
intWeekday = WeekDay(dtHoliday - lngDay)
If intWeekday = vbMonday Then
dtHoliday = dtHoliday - lngDay
Exit For
End If
Next lngDay
If dtEffDate = dtHoliday Then isHoliday = True
Case 7 'Check for July Holiday
'Determine Independence Day
'7/4 or Following Monday
dtHoliday = CDate("7/4/" & CStr(Year(dtEffDate)))
dtHoliday = GetFollowingMonday(dtHoliday)
If dtEffDate = dtHoliday Then isHoliday = True
Case 9 'Check for September Holiday
'Determine Labor Day
'1st Monday in September
dtHoliday = CDate("9/1/" & CStr(Year(dtEffDate)))
For lngDay = 0 To 29
intWeekday = WeekDay(dtHoliday + lngDay)
If intWeekday = vbMonday Then
dtHoliday = dtHoliday + lngDay
Exit For
End If
Next lngDay
If dtEffDate = dtHoliday Then isHoliday = True
Case 10 'Check for October Holiday
'Determine Columbus Day
'2nd Monday in October
dtHoliday = CDate("10/1/" & CStr(Year(dtEffDate)))
For lngDay = 0 To 30
intWeekday = WeekDay(dtHoliday + lngDay)
If intWeekday = vbMonday Then
dtHoliday = dtHoliday + lngDay + 7
Exit For
End If
Next lngDay
If dtEffDate = dtHoliday Then isHoliday = True
Case 11 'Check for November Holidays
'Determine Veteran's Day
'11/11 or Following Monday
dtHoliday = CDate("11/11/" & CStr(Year(dtEffDate)))
dtHoliday = GetFollowingMonday(dtHoliday)
If dtEffDate = dtHoliday Then
isHoliday = True
Exit Function
End If
'Determine Thanksgiving Day
'4th Thursday in November
dtHoliday = CDate("11/1/" & CStr(Year(dtEffDate)))
For lngDay = 0 To 29
intWeekday = WeekDay(dtHoliday + lngDay)
If intWeekday = vbThursday Then
dtHoliday = dtHoliday + lngDay + 21
Exit For
End If
Next lngDay
If dtEffDate = dtHoliday Then isHoliday = True
Case 12 'Check for December Holiday
'Determine Christmas Day
'12/25 or Following Monday
dtHoliday = CDate("12/25/" & CStr(Year(dtEffDate)))
dtHoliday = GetFollowingMonday(dtHoliday)
If dtEffDate = dtHoliday Then isHoliday = True
End Select
Exit_Proc:
Exit Function
ErrHandler:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbCritical, "Error Number " &
Err.Number
End Select
Resume Exit_Proc
Resume
End Function
------------------------------------------------------------------------------------------------------------
Public Function GetFollowingMonday(dtDate As Date) As Date
'Note Sunday = 0, Saturday = 7
On Error GoTo ErrHandler
Dim intWeekday As Integer
intWeekday = WeekDay(dtDate)
Select Case intWeekday
Case vbMonday To vbFriday
GetFollowingMonday = dtDate
Case vbSaturday
GetFollowingMonday = dtDate + 2
Case vbSunday
GetFollowingMonday = dtDate + 1
End Select
Exit_Proc:
Exit Function
ErrHandler:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbCritical, "Error Number " &
Err.Number
End Select
Resume Exit_Proc
Resume
End Function
--------------------------------------------------------------------------------------------------------------
Here's how I call it in my main code:
dtEffDate = GetFollowingMonday(Date + 1)
If isHoliday(dtEffDate) Then
dtEffDate = GetFollowingMonday(dtEffDate + 1)
End If
Thanks in advance for your comments,
Jana
