Calculating Working Days

Question

I want to do a calculation between two dates ie, 22/1/99 and 5/5/99 and calculate the number of working days in the range. I am prepared to ignore bank holidays and holy days.

Basically I want to know how many Monday to Fridays there are in the time period. On the face of it, this seems like a simple formula, but I am finding that the result depends on the Day of the start date and the number of days not divisible by 7. The only way I can calc it at the moment is a function to do 7 case statements for Monday to Sunday, and embedded within each case, another case to check the remainder after dividing by 7.

This seems like a terribly awkward way to tackle this.

I have checked in Access-L archives and I cannot find a function to do this calc, has anyone any ideas ?

Answer

From: Shamil Salakhetdinov <shamil@marta.darts.spb.ru>
To: <accessd@mtgroup.com>
Subject: Re: [accessd] Calculating Working Days
Date: 23 April 1999 2:05

Mark,

Enclosed are the functions I wrote three years ago to solve the subject. They aren't perfect but they should work OK.

HTH,
Shamil

P.S. The code:

'*+
'  Public domain. Written by Shamil Salakhetdinov. 1996.
'  DARTS Ltd., St.Petersburg, Russia
'  e-mail: shamil@marta.darts.spb.ru
'  URL: http//marta.darts.spb.ru
'*-
'
'  Function smsQtyOfWorkingDays (pvarStartDate As Variant, pvarEndDate As
Variant) As Integer
'
'  This function calculates the quantity of working days between two dates.
'  If StartDate > EndDate result is negative.
'
'*-
'
'  The speed of calculation does not depend on the quantity of workingdays
between two dates.
'  Below are the test measurements of the calculation speed compared with
the WorkDays() function
'  ('The Key to Access' April 1996). Test environment: Pentium 166, 32MB,
Win95, MS Access 2.0 .
'  Test functions were cycled 1000 times calculating workdays.
'
'  SDate    EDate   WorkDaysQty  WorkDays()
smsQtyOfWorkingDaysBetween2WeekDays(..)
'  -----    ------  -----------  --------------------------    -------------
--------------------------
' '1/1/96 - 1/2/96: 23 workdays, ~10s, 1.15740738692693E-07  - < 1s,
1.15740767796524E-08
' '1/1/96 - 1/3/96: 44 workdays, ~20s, 2.19907407881692E-07  - < 1s,
1.15740767796524E-08
' '1/1/96 - 1/3/96, 65 workdays, ~30s, 3.47222223354038E-07  - < 1s,
1.15740695036948E-08
' ...
' '1/1/66 - 1/4/96, 7890 workdays,   --- ??? ---             - < 1s,
1.15740767796524E-08
'*-
Function smsQtyOfWorkingDays(pvarStartDate As Variant, pvarEndDate As
Variant) As Integer
    On Error GoTo smsQtyOfWorkingDays_Err

    Dim lngStartDate As Long, lngEndDate As Long

    lngStartDate = CLng(CVDate(pvarStartDate))
    lngEndDate = CLng(CVDate(pvarEndDate))
    If lngStartDate <= lngEndDate Then
       smsQtyOfWorkingDays = DateDiff("w", lngStartDate, lngEndDate) * 5 +
smsQtyOfWorkingDaysBetween2WeekDays(WeekDay(lngStartDate),
WeekDay(lngEndDate))
    Else
       lngStartDate = CLng(CVDate(pvarEndDate))
       lngEndDate = CLng(CVDate(pvarStartDate))
       smsQtyOfWorkingDays = -(DateDiff("w", lngStartDate, lngEndDate) * 5 +
smsQtyOfWorkingDaysBetween2WeekDays(WeekDay(lngStartDate),
WeekDay(lngEndDate)))
    End If

smsQtyOfWorkingDays_Done:
    Exit Function
smsQtyOfWorkingDays_Err:
    Resume smsQtyOfWorkingDays_Done
End Function

'*+
'
'  This function calculates the quantity of working days
'  between two WeekDays. The weekdays' numbers are:
'
'  Sun Mon Tue Wed Thu Fri Sat
'   |---|---|---|---|---|---|
'   1   2   3   4   5   6   7
'
'*-
Function smsQtyOfWorkingDaysBetween2WeekDays(intFirstWeekDay As Integer,
intSecondWeekDay As Integer)
    On Error GoTo smsQtyOfWorkingDaysBetween2WeekDays_Err

    smsQtyOfWorkingDaysBetween2WeekDays = 0
    Dim intForIdx As Integer, intCycle2 As Integer, intCnt As Integer

    intCnt = 0
    If intFirstWeekDay <> intSecondWeekDay Then
       If intFirstWeekDay < intSecondWeekDay Then
          intCycle2 = intSecondWeekDay
       Else
          intCycle2 = intSecondWeekDay + 7
       End If

       For intForIdx = intFirstWeekDay To intCycle2 - 1
           Select Case intForIdx Mod 7
        Case 1, 7:
        Case 2, 3, 4, 5, 6: intCnt = intCnt + 1
        Case Else
           End Select
       Next intForIdx
    End If
    smsQtyOfWorkingDaysBetween2WeekDays = intCnt

smsQtyOfWorkingDaysBetween2WeekDays_Done:
    Exit Function
smsQtyOfWorkingDaysBetween2WeekDays_Err:
    Resume smsQtyOfWorkingDaysBetween2WeekDays_Done
End Function