While I have been able to find an example of how to calculate the number of business days between two dates, I haven't been able to find a published method to add business days. Excel has recently added this function, but Microsoft has yet to give it to the Access world. So, I have undertaken this challenge. The function that I have created allows the user to specify what days are not included in the count (for weekends) and it also allows for a list of holidays to be excluded as well. Holidays must be entered in a table for this to work. I have created my own method for automatically getting this information from the Internet, but that is a subject for another post.
Tables
The best method that I could come up with was to have a list of available dates and then to count down the records for the specified number of days. This means that we need a list of dates. Instead of having to type them all into a table, we will let Access take care of this problem. All we need is a table with a single field in it:
Expand|Select|Wrap|Line Numbers
- tbl_ExpansionDigits
- Digit
We also need a table of holidays. My table has a date field and a name field so that I can list the holiday name if I want to.
Expand|Select|Wrap|Line Numbers
- dbo_Holidays
- hDate
- hName
Queries
We actually only need one query. This is what performs the magic of giving us dates. Mine is named qryPossibleDates.
Expand|Select|Wrap|Line Numbers
- SELECT Cdate([tbl_expansiondigits_1]![Digit]
- +[tbl_expansiondigits_2]![Digit]*10
- +[tbl_expansiondigits_3]![Digit]*100
- +[tbl_expansiondigits_4]![Digit]*1000
- +[tbl_expansiondigits_5]![Digit]*10000) AS CalcDate, Weekday(CalcDate) AS WeekDayNumber
- FROM tbl_expansiondigits AS tbl_expansiondigits_1, tbl_expansiondigits AS tbl_expansiondigits_2, tbl_expansiondigits AS tbl_expansiondigits_3, tbl_expansiondigits AS tbl_expansiondigits_4, tbl_expansiondigits AS tbl_expansiondigits_5
- WHERE ((([tbl_expansiondigits_1]![Digit]
- +[tbl_expansiondigits_2]![Digit]*10
- +[tbl_expansiondigits_3]![Digit]*100
- +[tbl_expansiondigits_4]![Digit]*1000
- +[tbl_expansiondigits_5]![Digit]*10000)>=36000));
Code
First we are going to need a function to convert a binary-like number to a decimal value. I use this to for binary flags to know which days to exclude from the count.
Expand|Select|Wrap|Line Numbers
- Private Function ConvertToDecimal(lngBinary As Long) As Long
- Dim strNumber As String
- Dim i As Integer
- Dim lngAccumulator As Long
- Dim n As Integer
- Dim s As String
- Dim p As Integer
- strNumber = Format(lngBinary, "00000000")
- p = 1
- For i = 8 To 1 Step -1
- s = Mid(strNumber, p, 1)
- If s = "1" Then
- n = CInt(i) - 1
- lngAccumulator = lngAccumulator + 2 ^ n
- End If
- p = p + 1
- Next
- ConvertToDecimal = lngAccumulator
- End Function
Expand|Select|Wrap|Line Numbers
- Public Function AddDays(dteStart As Date, intInterval As Integer, lngExcludePattern As Long) As Date
- Dim lngExcludeDates As Long
- Dim strSelect As String
- Dim strWhere As String
- Dim strSQL As String
- Dim db As DAO.Database
- Dim rst As DAO.Recordset
- Dim i As Integer
- If lngExcludePattern <> 0 Then
- lngExcludeDates = ConvertToDecimal(lngExcludePattern)
- strSelect = "SELECT CalcDate As AddedDate FROM qryPossibleDates"
- strWhere = "CalcDate = #" & dteStart & "# Or (CalcDate >= #" & dteStart & "# And CalcDate Not In(SELECT hDate FROM dbo_Holidays WHERE hDate >= #" & dteStart & "#)"
- If (lngExcludeDates And 64) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 1"
- End If
- If (lngExcludeDates And 32) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 2"
- End If
- If (lngExcludeDates And 16) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 3"
- End If
- If (lngExcludeDates And 8) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 4"
- End If
- If (lngExcludeDates And 4) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 5"
- End If
- If (lngExcludeDates And 2) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 6"
- End If
- If (lngExcludeDates And 1) > 0 Then
- strWhere = strWhere & " And WeekDayNumber <> 7"
- End If
- strWhere = strWhere & ")"
- strSQL = strSelect & " WHERE " & strWhere
- Debug.Print strSQL
- Set db = CurrentDb
- Set rst = db.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
- rst.Move intInterval
- AddDays = rst!AddedDate
- Set db = Nothing
- rst.Close
- Set rst = Nothing
- Else
- AddDays = dteStart + intInterval
- End If
- End Function
Use
To use this function, you pass the start date to which you want to add x number of days (dteStart), the number of days that you want to add (intInterval) and then the days that you want to exclude (lngExcludePattern). The first two are pretty simple, but the Exclude Pattern needs more explanation. I have it setup to do it as binary flags. The first flag is Sunday and the last flag is Saturday. So if I want my weekends to be Saturday and Sunday, my Exclude Pattern would be 1000001. If I want Wednesdays excluded as well, then my pattern would be 1001001. If I just want Saturdays excluded it would be 0000001, which can also be entered as 1 because it is passed as a long integer. So if I want to add 5 days to 1/17/16, excluding Saturdays and Sundays, I would call my function like this:
Expand|Select|Wrap|Line Numbers
- =AddDays(#1/17/16#, 5, 1000001)
Conclusion
There are probably other ways to do this, but this seemed like the most versatile method and it actually does what I want it to. If anyone has any critiques, I welcome them.