Bolte IT Consulting

Calculate work (working / business) days in period

Below method can be used in order to calculate work (working / business) days in VBScript ignoring bank holidays.

Version History

Version  Date  Description 
0.1  2014-11-12 Initial commit.
0.2  2015-05-20  Replaced the old algorithm with a smarter solution, which is also regarding the fact that the start date can be younger than an end date. 

Source Code

The old version failed in calculating the difference in days between dates if the start date was younger than the end date of a period.

Furthermore this solution is expected to be slightly faster and it is more elegant.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
' @Author - Alexander Bolte
' @ChangeDate - 2015-05-20
' @Description - calculates the difference of whole work days
' between provided dates.
' @Param dtStart - a Date providing the start date of a period.
' @Param dtEnd - a Date providing the end date of a period.
' @Returns an Integer holding the difference in work days in defined period.
Function getWorkDaysDiff(dtStart, dtEnd)
	Dim weeks ' As Integer
  Dim weekDays ' As Integer
  Dim lastDays ' As Integer
  Dim firstDays ' As Integer
  Dim workDays ' As Integer
 
  If dtStart <= dtEnd Then
	' Calculate the difference of weeks and sbstract one
	' because we have to exclude the week of a handed start date.
	weeks = DateDiff("ww", dtStart, dtEnd) - 1
	' Calculate the number of work days in whole weeks.
	weekDays = weeks * 5
 
	If Weekday(dtStart) = vbSaturday Then
	    firstDays = 0
	Else
	    firstDays = 7 - Weekday(dtStart) - 1
	End If
 
	If Weekday(dtEnd) = vbSaturday Then
	   lastDays = Weekday(dtEnd) - 2
	Else
	   lastDays = Weekday(dtEnd) - 1
	End If
 
	workDays = firstDays + lastDays + weekDays
  Else
	' Call the method recursively in order to avoid having to code around the
	' comparisons above into the negative direction.
	workDays = getWorkDaysDiff(dtEnd, dtStart) * -1
  End If
 
  getWorkDaysDiff = workDays
End Function

The original algorithm can be found here, but I think it also does leave a calling method with having to decide what date to hand as start date.

http://www.codeproject.com/Articles/10641/Optimized-Calculation-Algorithm-for-Business-Days

Have not checked this algorithm for calculating business / work days yet, but will test it and maybe replace the above again.

https://alecpojidaev.wordpress.com/2009/10/29/work-days-calculation-with-c/

Old Source Code

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
' @Author - Alexander Bolte
' @ChangeDate - 2014-11-12
' @Description - calculating and returning the difference of whole work days
' between provided dates.
' @Param dtStart - a Date providing the start date of viewed period.
' @Param dtEnd - a Date providing the end date of a viewed period.
' @Returns an Integer holding the difference in work days in defined period.
Function getWorkDaysDiff(dtStart, dtEnd)
   Dim totalDays ' As Integer
   Dim totalWeeks ' As Integer
   Dim daysFirstWeek ' As Integer
   Dim daysLastWeek ' As Integer
   Dim modDays ' As Integer
 
   totalDays = DateDiff("D", dtStart, dtEnd)
   totalWeeks = DateDiff("W", dtStart, dtEnd)
 
   'COUNT DAYS IN FIRST WEEK -WEEKENDS
   Select Case WeekDay(dtStart)
   Case vbMonday
   daysFirstWeek = 5
   Case vbTuesday
   daysFirstWeek = 4
   Case vbWednesday
   daysFirstWeek = 3
   Case vbThursday
   daysFirstWeek = 2
   Case vbFriday
   daysFirstWeek = 1
   Case vbSaturday
   daysFirstWeek = 0
   Case vbSunday
   daysFirstWeek = 0
   End Select
 
   'COUNT DAYS IN END WEEK -WEEKENDS
   Select Case WeekDay(dtEnd)
   Case vbSaturday
   daysLastWeek = 0
   Case vbSunday
   daysLastWeek = 0
   Case vbMonday
   daysLastWeek = 0
   Case vbTuesday
   daysLastWeek = 1
   Case vbWednesday
   daysLastWeek = 2
   Case vbThursday
   daysLastWeek = 3
   Case vbFriday
   daysLastWeek = 4
   End Select
 
   modDays = totalDays Mod 7
 
   'GET DAYS OUTSIDE OF WEEKS
   if modDays < daysFirstWeek + daysLastWeek then
      oddDays = modDays
   else
      oddDays = daysFirstWeek + daysLastWeek
   end if 'modDays < daysFirstWeek + daysLastWeek
 
   if totalDays < daysFirstWeek then
      wrkDays = totalDays + (totalWeeks * 5)
   else
      wrkDays = oddDays + (totalWeeks * 5)
   end if 'totalDays < daysFirstWeek
 
   getWorkDaysDiff = wrkDays
End Function

 

Hits: 6260