In a recent project, I had to build a program to calculate an end date in either business days or calendar days based on certain criteria.
This solution had to work in both Excel and Access and needed to run without the use of database tables.
Business Day Calculation Requirements
The criteria I used to determine the definition of a business day was any non holiday weekday. For my holiday definitions, I used an array of standard, US government recognized holidays.
NOTE: For locations outside the US, please pay attention to and modify the holiday Array definitions and Array length.
VBA Business Day Calculation Code
For simplicity sake, I divided my code into three functions:
- businessDays(Start Date, Number of Business Days From Start). This is the main function to call to find the end result date from start date plus business days. Dependencies: isExclude, isWeekend
- isExclude(testDate). This function checks to see if the date entered is a holiday or excluded date based on the array. Returns Boolean (True or False)
- isWeekend(testDate). This function checks to see if the date entered is a weekend(Saturday or Sunday). Returns Boolean (True or False)
Function businessDays(stDay As Date, eDay As Integer) As Date
Do While i < eDay
If isWeekend(stDay) = True Then
i = i + 0
ElseIf isExclude(stDay) = True Then
i = i + 0
Else
i = i + 1
End If
stDay = stDay + 1
Loop
businessDays = stDay
End Function
Function isExclude(testDate As Date) As Boolean
Dim excludeDates(1 To 10) As Date
'Holiday List
'''''''''''''''''''''''''''''''''''''''''''''
excludeDates(1) = #1/1/2014# 'New Years Day
excludeDates(2) = #1/20/2014# 'MLK Jr. Day
excludeDates(3) = #2/17/2014# 'Presidents' Day
excludeDates(4) = #5/26/2014# 'Memorial Day
excludeDates(5) = #7/4/2014# 'Independence Day
excludeDates(6) = #9/1/2014# 'Labor Day
excludeDates(7) = #10/13/2014# 'Columbus Day
excludeDates(8) = #11/11/2014# 'Veterans Day
excludeDates(9) = #11/27/2014# 'Thanksgiving
excludeDates(10) = #12/25/2014# 'Christmas
'Missing Government Date - Add Inauguration Day:
'First January 20 following a Presidential election
For i = 1 To 10
If testDate = excludeDates(i) Then
isExclude = True
Exit Function
End If
Next i
isExclude = False
End Function
Function isWeekend(testDate As Date) As Boolean
Select Case Weekday(testDate)
Case vbSaturday, vbSunday
isWeekend = True
Case Else
isWeekend = False
End Select
End Function
Test Code
To test the above code:
Function whatDay()
Dim getDate As Date, getBusDays As Integer
getDate = InputBox("Start Date")
getBusDays = InputBox("Business Days")
MsgBox businessDays(getDate, getBusDays)
End Function
Special Note - Holidays
This example was designed using an array of fixed dates for 2014 Holidays. Please make sure to update holiday dates for future years.
As always, please comment with improvements, suggestions,
Your code has bugs!
Test with 08/12/2016 friday with 1 businessday.
Result is 08/13/2016 saturday instead of 08/15/2016 monday…
Thank you for creating this!
I had an issue where if the return date was a weekend, it would still return that date. I also changed the code to auto calculate the holiday.
Function businessDays(stDay As Date, eDay As Integer) As Date
Dim i As Integer
Do While i < eDay
If isWeekend(stDay) = True Then
i = i + 0
ElseIf isExclude(stDay) = True Then
i = i + 0
Else
i = i + 1
End If
stDay = stDay + 1
Loop
If isWeekend(stDay) = True Or isExclude(stDay) = True Then
businessDays = businessDays(stDay, 1)
Else
businessDays = stDay
End If
End Function
Function isExclude(testDate As Date) As Boolean
Dim excludeDates(1 To 11) As Date
Dim intyear As Integer
intyear = Format(testDate, "YYYY")
Dim i As Integer
'Holiday List
'''''''''''''''''''''''''''''''''''''''''''''
excludeDates(1) = CDate("1/1/" & intyear) 'New Years Day
excludeDates(2) = CDate("1/20/" & intyear) '#1/20/2014# 'MLK Jr. Day
excludeDates(3) = CDate("2/17/" & intyear) '#2/17/2014# 'Presidents' Day
excludeDates(4) = CDate("5/26/" & intyear) '#5/26/2014# 'Memorial Day
excludeDates(5) = CDate("7/4/" & intyear) '#7/4/2014# 'Independence Day
excludeDates(6) = CDate("9/16/" & intyear) '#9/1/2014# 'Labor Day
excludeDates(7) = CDate("10/13/" & intyear) '#10/13/2014# 'Columbus Day
excludeDates(8) = CDate("11/1/" & intyear) '#11/11/2014# 'Veterans Day
excludeDates(9) = CDate("11/27/" & intyear) '#11/27/2014# 'Thanksgiving
excludeDates(10) = CDate("12/25/" & intyear) '#12/25/2014# 'Christmas
'Missing Government Date – Add Inauguration Day:
'First January 20 following a Presidential election
For i = 1 To 10
If testDate = excludeDates(i) Then
isExclude = True
Exit Function
End If
Next i
isExclude = False
End Function
Function isWeekend(testDate As Date) As Boolean
Select Case Weekday(testDate)
Case vbSaturday, vbSunday
isWeekend = True
Case Else
isWeekend = False
End Select
End Function