Binaryworld - BusinessDateDiff - Evaluate the number of business days between two da ... [ VB -> Date-Time ]

' Evaluate the number of business days between two dates
'
' Note that it doesn't take Christmas, Easter and
' other holidays into account

Function BusinessDateDiff(ByVal StartDate As Date, ByVal EndDate As Date, _
  Optional ByVal SaturdayIsHoliday As Boolean = True) As Long
  Dim incr As Date

  ' ensure we don't take time part into account
  StartDate = Int(StartDate)
  EndDate = Int(EndDate)

  ' incr can be +1 or -1
  If StartDate < EndDate Then incr = 1 Else incr = -1

  Do Until StartDate = EndDate
    ' skip to previous or next day
    StartDate = StartDate + incr
    If Weekday(StartDate) <> vbSunday And (Weekday(StartDate) <> vbSaturday _
      Or Not SaturdayIsHoliday) Then
      ' if it's a weekday add/subtract one to the result
      BusinessDateDiff = BusinessDateDiff + incr
    End If
  Loop
  ' when the loop is exited the function name
  ' contains the correct result
End Function

' UPDATE: Albert C. Boettger sent us a new version of BusinessDateDiff,
' which is over 50 times faster than the old version!
Public Function BusinessDateDiff(ByVal StartDate As Date, ByVal EndDate As Date, _
  Optional ByVal SaturdayIsHoliday As Boolean = True) As Long
Dim nDow1 As Integer, nDow2 As Integer
nDow1 = Weekday(StartDate, vbSunday)
nDow2 = Weekday(EndDate, vbSunday)
If SaturdayIsHoliday Then
  BusinessDateDiff = DateDiff("ww", StartDate, EndDate, _
    vbSunday) * 5 - nDow1 + nDow2 - IIf(nDow2 = 7, 1, 0) + IIf(nDow1 = 7, 1, _
    0)
Else
  BusinessDateDiff = DateDiff("ww", StartDate, EndDate, _
    vbSunday) * 6 - nDow1 + nDow2
End If
End Function

' ====== Performance test ======

Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Function TimeTest()
Dim nx As Integer, t1 As Single, t2 As Single
Dim nDays As Integer

t1 = GetTickCount()
For nx = 1 To 10000
  nDays = BusinessDateDiff(#1/1/2002#, #12/31/2002#, True)
Next nx
t2 = GetTickCount()

Debug.Print "Test Complete: " & t2 - t1 & " milliseconds"
End Function

' Results Using Old BusinessDateDiff = "Test Complete: 17344 milliseconds"
' Results Using New BusinessDateDiff = "Test Complete: 192 milliseconds"
' ==> In this test, the new routine is approximately 90 times faster...

' Running test again over a smaller interval using the following test line:
' nDays = BusinessDateDiff(#1/1/2002#, #1/10/2002#, True)
' produced these results:
' Old BusinessDateDiff="Test Complete: 10880 milliseconds"
' New BusinessDateDiff="Test Complete: 192 milliseconds"
' ==> This test shows that the new routine is 57 times faster even when the
' loop count is small.

' In short, the new routine has constant performance regardless of the time
' interval between the start and end dates, while the old routine suffered with
' a linear decrease in performance as the time interval increased.