Login | Register   
LinkedIn
Google+
Twitter
RSS Feed
Download our iPhone app
TODAY'S HEADLINES  |   ARTICLE ARCHIVE  |   FORUMS  |   TIP BANK
Browse DevX
Sign up for e-mail newsletters from DevX


Tip of the Day
Language: VB4,VB5,VB6,VBS
Expertise: Intermediate
Oct 7, 2000

BusinessDateDiff - Evaluate the number of business days between two dates

' 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.
Francesco Balena
 
Comment and Contribute

 

 

 

 

 


(Maximum characters: 1200). You have 1200 characters left.

 

 

Sitemap
Thanks for your registration, follow us on our social networks to keep up-to-date