Jason Wilson
2007-01-11 21:23:53 UTC
I have searched the web for an algorithm that would allow me to
calculate the number of business hours between two date/times taking
into account weekends, working hours, and holidays. Since I had no
luck finding one, I decided to write one myself and share the results
with the world. This function takes a start date/time, end date/time,
beginning time of workday, ending time of workday, and an array of
dates to exclude (holidays).
Here's the code:
Function CalcBusinessHours( ByVal sStart, ByVal sEnd, ByVal
sBusinessDayBegin, ByVal sBusinessDayEnd, ByVal aExcludedDays )
'*** Declare Variables ***
Dim sStartDate
Dim sStartMinute
Dim sStartTime
Dim sEndDate
Dim sEndMinute
Dim sEndTime
Dim iWeekDay
Dim dictExludedDays
Dim x
Dim iExcludedDay
Dim iExcludedDate
Dim bIsExcluded
Dim sDiff
Dim iHours
Dim iDays
Dim iModHours
Dim iWeeks
Dim iExcludedCount
Dim sTempDate
'*** Check for Blank BusinessDay Info ***
If sBusinessDayBegin = "" Then sBusinessDayBegin = "8:00"
If sBusinessDayEnd = "" Then sBusinessDayEnd = "17:00"
'*** Check for Invalid Dates ***
If IsDate( sStart) = False Or IsDate( sEnd ) = False Or IsDate(
sBusinessDayBegin ) = False Or IsDate( sBusinessDayEnd ) = False Then
CalcBusinessHours = -1 '-1 is an error
Exit Function
End If
If IsArray( aExcludedDays ) Then
For x = 0 To UBound( aExcludedDays)
If IsDate(aExcludedDays(x)) = False Then
CalcBusinessHours = -1
Exit Function
End If
Next
End If
'*** If No Time Provided for Start and End and midnight and 23:59 ***
sStartDate = DatePart( "m", sStart ) & "/" & DatePart( "d", sStart )
& "/" & DatePart( "yyyy", sStart )
If DatePart( "h", sStart ) = 0 And DatePart( "n", sStart ) = 0 Then
sStart = sStartDate & " 0:00"
sEndDate = DatePart( "m", sEnd ) & "/" & DatePart( "d", sEnd ) & "/"
& DatePart( "yyyy", sEnd )
If DatePart( "h", sEnd ) = 0 And DatePart( "n", sEnd ) = 0 Then sEnd
= sEndDate & " 23:59"
'*** Check for Start After End ***
If DateDiff( "n", sStart, sEnd ) < 0 Then
CalcBusinessHours = -1 '-1 is an error
Exit Function
End If
'*** If Start is on a Weekend Move to Beginning of Next Business Day
***
sStartMinute = DatePart( "n", sStart )
Do While Len( sStartMinute ) < 2 'Make sure minutes is 2 characters
long
sStartMinute = "0" & sStartMinute
Loop
sStartTime = DatePart( "h", sStart ) & ":" & sStartMinute
iWeekDay = DatePart( "w", sStartDate )
If iWeekDay = 7 Then
sStartTime = "8:00"
sStartDate = DateAdd( "d", 2, sStartDate)
sStart = sStartDate & " " & sStartTime
ElseIf iWeekDay = 1 Then
sStartTime = "8:00"
sStartDate = DateAdd( "d", 1, sStartDate)
sStart = sStartDate & " " & sStartTime
End If
'*** If End is on a Weekend Move to Beginning of Next Business Day ***
sEndDate = DatePart( "m", sEnd ) & "/" & DatePart( "d", sEnd ) & "/"
& DatePart( "yyyy", sEnd )
sEndMinute = DatePart( "n", sEnd )
Do While Len( sEndMinute ) < 2 'Make sure minutes is 2 characters
long
sEndMinute = "0" & sEndMinute
Loop
sEndTime = DatePart( "h", sEnd ) & ":" & sEndMinute
iWeekDay = DatePart( "w", sEndDate )
If iWeekDay = 7 Then
sEndTime = "8:00"
sEndDate = DateAdd( "d", 2, sEndDate)
sEnd = sEndDate & " " & sEndTime
ElseIf iWeekDay = 1 Then
sEndTime = "8:00"
sEndDate = DateAdd( "d", 1, sEndDate)
sEnd = sEndDate & " " & sEndTime
End If
'*** If Start is on Exluded Day Move to Begineeing of Next Business
Day ***
Set dictExludedDays = CreateObject( "Scripting.Dictionary" )
If IsArray( aExcludedDays ) Then
'-- Add Excluded Days to Dictionary --
For x = 0 To UBound( aExcludedDays )
iExcludedDay = DatePart( "y", aExcludedDays(x))
dictExludedDays.Add iExcludedDay, aExcludedDays(x)
Next
iExcludedDate = DatePart( "y", sStartDate)
bIsExcluded = dictExludedDays.Exists( iExcludedDate )
Do While bIsExcluded = True
sStartTime = "8:00"
sStartDate = DateAdd( "d", 1, sStartDate )
If DatePart( "w", sStartDate) = 7 Then sStartDate = DateAdd( "d",
2, sStartDate ) 'Adjust if New Date is a saturday
If DatePart( "w", sStartDate) = 1 Then sStartDate = DateAdd( "d",
1, sStartDate ) 'Adjust if new date is a sunday
sStart = sStartDate & " " & sStartTime
bIsExcluded = dictExludedDays.Exists( DatePart( "y", sStartDate) )
Loop
End If
'*** If End is on Exluded Day Move to Begineeing of Next Business Day
***
If IsArray( aExcludedDays ) Then
iExcludedDate = DatePart( "y", sEndDate)
bIsExcluded = dictExludedDays.Exists( iExcludedDate )
Do While bIsExcluded = True
sEndTime = "8:00"
sEndDate = DateAdd( "d", 1, sEndDate )
If DatePart( "w", sEndDate) = 7 Then sEndDate = DateAdd( "d", 2,
sEndDate ) 'Adjust if New Date is a saturday
If DatePart( "w", sEndDate) = 1 Then sEndDate = DateAdd( "d", 1,
sEndDate ) 'Adjust if new date is a sunday
sEnd = sEndDate & " " & sEndTime
bIsExcluded = dictExludedDays.Exists( DatePart( "y", sEndDate) )
Loop
End If
'*** If Start Before Busineess Hours Adjust Start Time to Beginning of
Business Hours ***
sDiff = DateDiff( "n", sBusinessDayBegin, sStartTime )
If sDiff < 0 Then
sStartTime = "8:00"
sStart = sStartDate & " " & sStartTime
End If
'*** If End Before Busineess Hours Adjust End Time to Beginning of
Business Hours ***
sDiff = DateDiff( "n", sBusinessDayBegin, sEndTime )
If sDiff < 0 Then
sEndTime = "8:00"
sEnd = sEndDate & " " & sEndTime
End If
'*** If Start After Business Hours Adjust Start to Beginning of
Business Hours on Next Day ***
sDiff = DateDiff( "n", sStartTime, sBusinessDayEnd )
If sDiff < 0 Then
sStartTime = "8:00"
sStartDate = DateAdd( "d", 1, sStartDate )
sStart = sStartDate & " " & sStartTime
End If
'*** If End After Business Hours Adjust Start to Beginning of Business
Hours on Next Day ***
sDiff = DateDiff( "n", sEndTime, sBusinessDayEnd )
If sDiff < 0 Then
sEndTime = "8:00"
sEndDate = DateAdd( "d", 1, sEndDate )
sEnd = sEndDate & " " & sEndTime
End If
'*** Calculate Hours Difference***
iHours = Round( DateDiff( "n", sStart, sEnd ) / 60, 1 )
'*** Adjust Business Hours For Start and End on Different Days ***
iDays = DateDiff( "d", sStartDate, sEndDate )
iModHours = 0
If iDays > 0 Then iModHours = iDays * 15
'*** Adjust Business Hours For a Weekend Between Start and End ***
iWeeks = DateDiff( "ww", sStartDate, sEndDate )
If iWeeks > 0 Then iModHours = iModHours + (18 * iWeeks)
'*** Adjust Business Hours For an Exluded Day between Start and End
***
iExcludedCount = 0
If iDays > 1 Then
sTempDate = DateAdd( "d", 1, sStartDate)
Do While sTempDate <> sEndDate
If DatePart( "w", sTempDate ) <> 7 And DatePart( "w", sTempDate )
<> 1 Then
If dictExludedDays.Exists( DatePart( "y", sTempDate) ) Then
iExcludedCount = iExcludedCount + 1
End If
sTempDate = DateAdd( "d", 1, sTempDate)
Loop
If iExcludedCount > 0 Then iModHours = iModHours + (iExcludedCount *
9)
End If
CalcBusinessHours = iHours - iModHours
End Function
calculate the number of business hours between two date/times taking
into account weekends, working hours, and holidays. Since I had no
luck finding one, I decided to write one myself and share the results
with the world. This function takes a start date/time, end date/time,
beginning time of workday, ending time of workday, and an array of
dates to exclude (holidays).
Here's the code:
Function CalcBusinessHours( ByVal sStart, ByVal sEnd, ByVal
sBusinessDayBegin, ByVal sBusinessDayEnd, ByVal aExcludedDays )
'*** Declare Variables ***
Dim sStartDate
Dim sStartMinute
Dim sStartTime
Dim sEndDate
Dim sEndMinute
Dim sEndTime
Dim iWeekDay
Dim dictExludedDays
Dim x
Dim iExcludedDay
Dim iExcludedDate
Dim bIsExcluded
Dim sDiff
Dim iHours
Dim iDays
Dim iModHours
Dim iWeeks
Dim iExcludedCount
Dim sTempDate
'*** Check for Blank BusinessDay Info ***
If sBusinessDayBegin = "" Then sBusinessDayBegin = "8:00"
If sBusinessDayEnd = "" Then sBusinessDayEnd = "17:00"
'*** Check for Invalid Dates ***
If IsDate( sStart) = False Or IsDate( sEnd ) = False Or IsDate(
sBusinessDayBegin ) = False Or IsDate( sBusinessDayEnd ) = False Then
CalcBusinessHours = -1 '-1 is an error
Exit Function
End If
If IsArray( aExcludedDays ) Then
For x = 0 To UBound( aExcludedDays)
If IsDate(aExcludedDays(x)) = False Then
CalcBusinessHours = -1
Exit Function
End If
Next
End If
'*** If No Time Provided for Start and End and midnight and 23:59 ***
sStartDate = DatePart( "m", sStart ) & "/" & DatePart( "d", sStart )
& "/" & DatePart( "yyyy", sStart )
If DatePart( "h", sStart ) = 0 And DatePart( "n", sStart ) = 0 Then
sStart = sStartDate & " 0:00"
sEndDate = DatePart( "m", sEnd ) & "/" & DatePart( "d", sEnd ) & "/"
& DatePart( "yyyy", sEnd )
If DatePart( "h", sEnd ) = 0 And DatePart( "n", sEnd ) = 0 Then sEnd
= sEndDate & " 23:59"
'*** Check for Start After End ***
If DateDiff( "n", sStart, sEnd ) < 0 Then
CalcBusinessHours = -1 '-1 is an error
Exit Function
End If
'*** If Start is on a Weekend Move to Beginning of Next Business Day
***
sStartMinute = DatePart( "n", sStart )
Do While Len( sStartMinute ) < 2 'Make sure minutes is 2 characters
long
sStartMinute = "0" & sStartMinute
Loop
sStartTime = DatePart( "h", sStart ) & ":" & sStartMinute
iWeekDay = DatePart( "w", sStartDate )
If iWeekDay = 7 Then
sStartTime = "8:00"
sStartDate = DateAdd( "d", 2, sStartDate)
sStart = sStartDate & " " & sStartTime
ElseIf iWeekDay = 1 Then
sStartTime = "8:00"
sStartDate = DateAdd( "d", 1, sStartDate)
sStart = sStartDate & " " & sStartTime
End If
'*** If End is on a Weekend Move to Beginning of Next Business Day ***
sEndDate = DatePart( "m", sEnd ) & "/" & DatePart( "d", sEnd ) & "/"
& DatePart( "yyyy", sEnd )
sEndMinute = DatePart( "n", sEnd )
Do While Len( sEndMinute ) < 2 'Make sure minutes is 2 characters
long
sEndMinute = "0" & sEndMinute
Loop
sEndTime = DatePart( "h", sEnd ) & ":" & sEndMinute
iWeekDay = DatePart( "w", sEndDate )
If iWeekDay = 7 Then
sEndTime = "8:00"
sEndDate = DateAdd( "d", 2, sEndDate)
sEnd = sEndDate & " " & sEndTime
ElseIf iWeekDay = 1 Then
sEndTime = "8:00"
sEndDate = DateAdd( "d", 1, sEndDate)
sEnd = sEndDate & " " & sEndTime
End If
'*** If Start is on Exluded Day Move to Begineeing of Next Business
Day ***
Set dictExludedDays = CreateObject( "Scripting.Dictionary" )
If IsArray( aExcludedDays ) Then
'-- Add Excluded Days to Dictionary --
For x = 0 To UBound( aExcludedDays )
iExcludedDay = DatePart( "y", aExcludedDays(x))
dictExludedDays.Add iExcludedDay, aExcludedDays(x)
Next
iExcludedDate = DatePart( "y", sStartDate)
bIsExcluded = dictExludedDays.Exists( iExcludedDate )
Do While bIsExcluded = True
sStartTime = "8:00"
sStartDate = DateAdd( "d", 1, sStartDate )
If DatePart( "w", sStartDate) = 7 Then sStartDate = DateAdd( "d",
2, sStartDate ) 'Adjust if New Date is a saturday
If DatePart( "w", sStartDate) = 1 Then sStartDate = DateAdd( "d",
1, sStartDate ) 'Adjust if new date is a sunday
sStart = sStartDate & " " & sStartTime
bIsExcluded = dictExludedDays.Exists( DatePart( "y", sStartDate) )
Loop
End If
'*** If End is on Exluded Day Move to Begineeing of Next Business Day
***
If IsArray( aExcludedDays ) Then
iExcludedDate = DatePart( "y", sEndDate)
bIsExcluded = dictExludedDays.Exists( iExcludedDate )
Do While bIsExcluded = True
sEndTime = "8:00"
sEndDate = DateAdd( "d", 1, sEndDate )
If DatePart( "w", sEndDate) = 7 Then sEndDate = DateAdd( "d", 2,
sEndDate ) 'Adjust if New Date is a saturday
If DatePart( "w", sEndDate) = 1 Then sEndDate = DateAdd( "d", 1,
sEndDate ) 'Adjust if new date is a sunday
sEnd = sEndDate & " " & sEndTime
bIsExcluded = dictExludedDays.Exists( DatePart( "y", sEndDate) )
Loop
End If
'*** If Start Before Busineess Hours Adjust Start Time to Beginning of
Business Hours ***
sDiff = DateDiff( "n", sBusinessDayBegin, sStartTime )
If sDiff < 0 Then
sStartTime = "8:00"
sStart = sStartDate & " " & sStartTime
End If
'*** If End Before Busineess Hours Adjust End Time to Beginning of
Business Hours ***
sDiff = DateDiff( "n", sBusinessDayBegin, sEndTime )
If sDiff < 0 Then
sEndTime = "8:00"
sEnd = sEndDate & " " & sEndTime
End If
'*** If Start After Business Hours Adjust Start to Beginning of
Business Hours on Next Day ***
sDiff = DateDiff( "n", sStartTime, sBusinessDayEnd )
If sDiff < 0 Then
sStartTime = "8:00"
sStartDate = DateAdd( "d", 1, sStartDate )
sStart = sStartDate & " " & sStartTime
End If
'*** If End After Business Hours Adjust Start to Beginning of Business
Hours on Next Day ***
sDiff = DateDiff( "n", sEndTime, sBusinessDayEnd )
If sDiff < 0 Then
sEndTime = "8:00"
sEndDate = DateAdd( "d", 1, sEndDate )
sEnd = sEndDate & " " & sEndTime
End If
'*** Calculate Hours Difference***
iHours = Round( DateDiff( "n", sStart, sEnd ) / 60, 1 )
'*** Adjust Business Hours For Start and End on Different Days ***
iDays = DateDiff( "d", sStartDate, sEndDate )
iModHours = 0
If iDays > 0 Then iModHours = iDays * 15
'*** Adjust Business Hours For a Weekend Between Start and End ***
iWeeks = DateDiff( "ww", sStartDate, sEndDate )
If iWeeks > 0 Then iModHours = iModHours + (18 * iWeeks)
'*** Adjust Business Hours For an Exluded Day between Start and End
***
iExcludedCount = 0
If iDays > 1 Then
sTempDate = DateAdd( "d", 1, sStartDate)
Do While sTempDate <> sEndDate
If DatePart( "w", sTempDate ) <> 7 And DatePart( "w", sTempDate )
<> 1 Then
If dictExludedDays.Exists( DatePart( "y", sTempDate) ) Then
iExcludedCount = iExcludedCount + 1
End If
sTempDate = DateAdd( "d", 1, sTempDate)
Loop
If iExcludedCount > 0 Then iModHours = iModHours + (iExcludedCount *
9)
End If
CalcBusinessHours = iHours - iModHours
End Function