Discussion:
VBSCRIPT: Calculate Business Hours
(too old to reply)
Jason Wilson
2007-01-11 21:23:53 UTC
Permalink
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
OldDog
2007-01-11 21:57:26 UTC
Permalink
Please forgive the newbie, but could you show a usage example?

Thanks,

OldDog
Post by Jason Wilson
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).
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
Jason Wilson
2007-01-31 14:42:21 UTC
Permalink
Post by OldDog
Please forgive the newbie, but could you show a usage example?
Thanks,
OldDog
I work for a radiology company. I use the function to calculate cycle
times from the time a medical exam is performed and the time we send
the resulting diagnosis and then compare to our SLAs to see which
results need to expediated.

I'll be converting to VB use in a new ASP.NET project in the near
future.
Dr J R Stockton
2007-01-12 17:36:54 UTC
Permalink
In microsoft.public.scripting.vbscript message <1168550633.520296.256070
@k58g2000hse.googlegroups.com>, Thu, 11 Jan 2007 13:23:53, Jason Wilson
Post by Jason Wilson
'*** 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
There should never be a need to compare with a Boolean literal.
Consider

If not ( IsDate( sStart ) and IsDate( sEnd ) and _
IsDate( sBusinessDayBegin ) and IsDate( sBusinessDayEnd ) ) Then ...


IsDate() is a very weak test; it will for example accept "1p". See
<URL:http://www.merlyn.demon.co.uk/vb-date1.htm#Val>.
--
(c) John Stockton, Surrey, UK. ?@merlyn.demon.co.uk Turnpike v6.05 IE 6.
Web <URL:http://www.merlyn.demon.co.uk/> - w. FAQish topics, links, acronyms
PAS EXE etc : <URL:http://www.merlyn.demon.co.uk/programs/> - see 00index.htm
Dates - miscdate.htm moredate.htm js-dates.htm pas-time.htm critdate.htm etc.
Jason Wilson
2007-01-31 14:38:14 UTC
Permalink
Post by Dr J R Stockton
There should never be a need to compare with a Boolean literal.
Consider
If not ( IsDate( sStart ) and IsDate( sEnd ) and _
IsDate( sBusinessDayBegin ) and IsDate( sBusinessDayEnd ) ) Then ...
You say TO MA' TO, I say TO MA~ TO...
manoah
2010-05-28 11:10:03 UTC
Permalink
Jason Wilson wrote on 01/11/2007 16:23 ET
Post by Jason Wilson
I have searched the web for an algorithm that would allow me t
calculate the number of business hours between two date/times takin
into account weekends, working hours, and holidays. Since I had n
luck finding one, I decided to write one myself and share the result
with the world. This function takes a start date/time, end date/time
beginning time of workday, ending time of workday, and an array o
dates to exclude (holidays)
Here's the code
Function CalcBusinessHours( ByVal sStart, ByVal sEnd, ByVa
sBusinessDayBegin, ByVal sBusinessDayEnd, ByVal aExcludedDays
'*** Declare Variables **
Dim sStartDat
Dim sStartMinut
Dim sStartTim
Dim sEndDat
Dim sEndMinut
Dim sEndTim
Dim iWeekDa
Dim dictExludedDay
Dim
Dim iExcludedDa
Dim iExcludedDat
Dim bIsExclude
Dim sDif
Dim iHour
Dim iDay
Dim iModHour
Dim iWeek
Dim iExcludedCoun
Dim sTempDat
'*** Check for Blank BusinessDay Info **
If sBusinessDayBegin = &quot;&quot; Then sBusinessDayBegin = &quot;8:00&quot
If sBusinessDayEnd = &quot;&quot; Then sBusinessDayEnd = &quot;17:00&quot
'*** Check for Invalid Dates **
If IsDate( sStart) = False Or IsDate( sEnd ) = False Or IsDate
sBusinessDayBegin ) = False Or IsDate( sBusinessDayEnd ) = False The
CalcBusinessHours = -1 '-1 is an erro
Exit Functio
End I
If IsArray( aExcludedDays ) The
For x = 0 To UBound( aExcludedDays
If IsDate(aExcludedDays(x)) = False The
CalcBusinessHours = -
Exit Functio
End I
Nex
End I
'*** If No Time Provided for Start and End and midnight and 23:59 **
sStartDate = DatePart( &quot;m&quot;, sStart ) &amp; &quot;/&quot; &amp
DatePart( &quot;d&quot;, sStart
&amp; &quot;/&quot; &amp; DatePart( &quot;yyyy&quot;, sStart
If DatePart( &quot;h&quot;, sStart ) = 0 And DatePart( &quot;n&quot;, sStar
= 0 The
sStart = sStartDate &amp; &quot; 0:00&quot
sEndDate = DatePart( &quot;m&quot;, sEnd ) &amp; &quot;/&quot; &amp
DatePart
Post by Jason Wilson
&quot;d&quot;, sEnd ) &amp; &quot;/&quot
&amp; DatePart( &quot;yyyy&quot;, sEnd
If DatePart( &quot;h&quot;, sEnd ) = 0 And DatePart( &quot;n&quot;, sEnd )
Then sEn
= sEndDate &amp; &quot; 23:59&quot
'*** Check for Start After End **
If DateDiff( &quot;n&quot;, sStart, sEnd ) &lt; 0 The
CalcBusinessHours = -1 '-1 is an erro
Exit Functio
End I
'*** If Start is on a Weekend Move to Beginning of Next Business Da
**
sStartMinute = DatePart( &quot;n&quot;, sStart
Do While Len( sStartMinute ) &lt; 2 'Make sure minutes is 2 character
lon
sStartMinute = &quot;0&quot; &amp; sStartMinut
Loo
sStartTime = DatePart( &quot;h&quot;, sStart ) &amp; &quot;:&quot; &amp
sStartMinut
iWeekDay = DatePart( &quot;w&quot;, sStartDate
If iWeekDay = 7 The
sStartTime = &quot;8:00&quot
sStartDate = DateAdd( &quot;d&quot;, 2, sStartDate
sStart = sStartDate &amp; &quot; &quot; &amp; sStartTim
ElseIf iWeekDay = 1 The
sStartTime = &quot;8:00&quot
sStartDate = DateAdd( &quot;d&quot;, 1, sStartDate
sStart = sStartDate &amp; &quot; &quot; &amp; sStartTim
End I
'*** If End is on a Weekend Move to Beginning of Next Business Day **
sEndDate = DatePart( &quot;m&quot;, sEnd ) &amp; &quot;/&quot; &amp
DatePart
Post by Jason Wilson
&quot;d&quot;, sEnd ) &amp; &quot;/&quot
&amp; DatePart( &quot;yyyy&quot;, sEnd
sEndMinute = DatePart( &quot;n&quot;, sEnd
Do While Len( sEndMinute ) &lt; 2 'Make sure minutes is 2 character
lon
sEndMinute = &quot;0&quot; &amp; sEndMinut
Loo
sEndTime = DatePart( &quot;h&quot;, sEnd ) &amp; &quot;:&quot; &amp
sEndMinut
Post by Jason Wilson
iWeekDay = DatePart( &quot;w&quot;, sEndDate
If iWeekDay = 7 The
sEndTime = &quot;8:00&quot
sEndDate = DateAdd( &quot;d&quot;, 2, sEndDate
sEnd = sEndDate &amp; &quot; &quot; &amp; sEndTim
ElseIf iWeekDay = 1 The
sEndTime = &quot;8:00&quot
sEndDate = DateAdd( &quot;d&quot;, 1, sEndDate
sEnd = sEndDate &amp; &quot; &quot; &amp; sEndTim
End If
'*** If Start is on Exluded Day Move to Begineeing of Next Business
Day ***
Set dictExludedDays = CreateObject( &quot;Scripting.Dictionary&quot; )
If IsArray( aExcludedDays ) Then
'-- Add Excluded Days to Dictionary --
For x = 0 To UBound( aExcludedDays )
iExcludedDay = DatePart( &quot;y&quot;, aExcludedDays(x))
dictExludedDays.Add iExcludedDay, aExcludedDays(x)
Next
iExcludedDate = DatePart( &quot;y&quot;, sStartDate)
bIsExcluded = dictExludedDays.Exists( iExcludedDate )
Do While bIsExcluded = True
sStartTime = &quot;8:00&quot;
sStartDate = DateAdd( &quot;d&quot;, 1, sStartDate )
If DatePart( &quot;w&quot;, sStartDate) = 7 Then sStartDate = DateAdd(
&quot;d&quot;,
2, sStartDate ) 'Adjust if New Date is a saturday
If DatePart( &quot;w&quot;, sStartDate) = 1 Then sStartDate = DateAdd(
&quot;d&quot;,
1, sStartDate ) 'Adjust if new date is a sunday
sStart = sStartDate &amp; &quot; &quot; &amp; sStartTime
bIsExcluded = dictExludedDays.Exists( DatePart( &quot;y&quot;, sStartDate) )
Loop
End If
'*** If End is on Exluded Day Move to Begineeing of Next Business Day
***
If IsArray( aExcludedDays ) Then
iExcludedDate = DatePart( &quot;y&quot;, sEndDate)
bIsExcluded = dictExludedDays.Exists( iExcludedDate )
Do While bIsExcluded = True
sEndTime = &quot;8:00&quot;
sEndDate = DateAdd( &quot;d&quot;, 1, sEndDate )
If DatePart( &quot;w&quot;, sEndDate) = 7 Then sEndDate = DateAdd(
&quot;d&quot;, 2,
sEndDate ) 'Adjust if New Date is a saturday
If DatePart( &quot;w&quot;, sEndDate) = 1 Then sEndDate = DateAdd(
&quot;d&quot;, 1,
sEndDate ) 'Adjust if new date is a sunday
sEnd = sEndDate &amp; &quot; &quot; &amp; sEndTime
bIsExcluded = dictExludedDays.Exists( DatePart( &quot;y&quot;, sEndDate) )
Loop
End If
'*** If Start Before Busineess Hours Adjust Start Time to Beginning of
Business Hours ***
sDiff = DateDiff( &quot;n&quot;, sBusinessDayBegin, sStartTime )
If sDiff &lt; 0 Then
sStartTime = &quot;8:00&quot;
sStart = sStartDate &amp; &quot; &quot; &amp; sStartTime
End If
'*** If End Before Busineess Hours Adjust End Time to Beginning of
Business Hours ***
sDiff = DateDiff( &quot;n&quot;, sBusinessDayBegin, sEndTime )
If sDiff &lt; 0 Then
sEndTime = &quot;8:00&quot;
sEnd = sEndDate &amp; &quot; &quot; &amp; sEndTime
End If
'*** If Start After Business Hours Adjust Start to Beginning of
Business Hours on Next Day ***
sDiff = DateDiff( &quot;n&quot;, sStartTime, sBusinessDayEnd )
If sDiff &lt; 0 Then
sStartTime = &quot;8:00&quot;
sStartDate = DateAdd( &quot;d&quot;, 1, sStartDate )
sStart = sStartDate &amp; &quot; &quot; &amp; sStartTime
End If
'*** If End After Business Hours Adjust Start to Beginning of Business
Hours on Next Day ***
sDiff = DateDiff( &quot;n&quot;, sEndTime, sBusinessDayEnd )
If sDiff &lt; 0 Then
sEndTime = &quot;8:00&quot;
sEndDate = DateAdd( &quot;d&quot;, 1, sEndDate )
sEnd = sEndDate &amp; &quot; &quot; &amp; sEndTime
End If
'*** Calculate Hours Difference***
iHours = Round( DateDiff( &quot;n&quot;, sStart, sEnd ) / 60, 1 )
'*** Adjust Business Hours For Start and End on Different Days ***
iDays = DateDiff( &quot;d&quot;, sStartDate, sEndDate )
iModHours = 0
'*** Adjust Business Hours For a Weekend Between Start and End ***
iWeeks = DateDiff( &quot;ww&quot;, sStartDate, sEndDate )
'*** Adjust Business Hours For an Exluded Day between Start and End
***
iExcludedCount = 0
sTempDate = DateAdd( &quot;d&quot;, 1, sStartDate)
&quot;w&quot;,
Post by Jason Wilson
sTempDate )
If dictExludedDays.Exists( DatePart( &quot;y&quot;, sTempDate) ) Then
iExcludedCount = iExcludedCount + 1
End If
sTempDate = DateAdd( &quot;d&quot;, 1, sTempDate)
Loop
9)
End If
CalcBusinessHours = iHours - iModHours
End Function
can you give sample with the function having sample paramerts?. Its not
working
for me
a***@gmail.com
2012-11-05 12:23:18 UTC
Permalink
Thanks for this. That saved me a lot of time.

Andrew
d***@gmail.com
2014-10-01 01:31:36 UTC
Permalink
Great function & saved me heaps of time - however it fails in Australia where we (correctly) day before month (honestly can't see the logic of putting month before day? causes so much heart-ache I tell you what!)
Anyway- here's my adjusted function for dd/mm/yyyy format and 9-5 business hours:
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 = "9: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( "d", sStart ) & "/" & DatePart( "m", sStart ) & "/" & DatePart( "yyyy", sStart )
If DatePart( "h", sStart ) = 0 And DatePart( "n", sStart ) = 0 Then sStart = sStartDate & " 0:00"
sEndDate = DatePart( "d", sEnd ) & "/" & DatePart( "m", 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 = "9:00"
sStartDate = DateAdd( "d", 2, sStartDate)
sStart = sStartDate & " " & sStartTime
ElseIf iWeekDay = 1 Then
sStartTime = "9: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( "d", sEnd ) & "/" & DatePart( "m", 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 = "9:00"
sEndDate = DateAdd( "d", 2, sEndDate)
sEnd = sEndDate & " " & sEndTime
ElseIf iWeekDay = 1 Then
sEndTime = "9: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 = "9: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 = "9:00"
sStart = sStartDate & " " & sStartTime
End If
session("test")="sStart:" & sStart & " sDiff:" & sDiff

'*** If End Before Busineess Hours Adjust End Time to Beginning of Business Hours ***
sDiff = DateDiff( "n", sBusinessDayBegin, sEndTime )
If sDiff < 0 Then
sEndTime = "9: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 = "9: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 = "9: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
Evertjan.
2014-10-01 07:59:12 UTC
Permalink
Post by d***@gmail.com
Great function & saved me heaps of time - however it fails in Australia
where we (correctly) day before month (honestly can't see the logic of
putting month before day? causes so much heart-ache I tell you what!)
I would never, never build a "linear" function this way.
Yes, this was the way Basic was used in the '60s.

Methinks it is much better to build ***MODULAR***,
starting with primitive functions you trust and use in many places, like:

function twoChar(d) ' for minutes, seconds, days and months
twoChar = right("0" & d, 2)
end function

function makeTimeString(d)
makeTimeString = twoChar(hours(d)) & ":" & twoChar(minutes(d))
end function

etc

put them at the bottom of your script
and forget about the inside of these black boxes,
after testing and debugging ofcourse.

Make function that prepares the semi-fixed values, like
CONST buzDayStart [global!]
buzDayStart = "9:00"
and for instance fetch them from a small database.

btw, I would define date/time values here
so you can calculate with them later
buzDayStart = cdate("9:00")
[ halfHourbeforeStart = cdate(buzDayStart - cdate("00:30")) ]

Then make the testing functions
[these all return boolean true/false]

function isFreeDAY() ...
function isHolyDAY() ...
function isInsideHOURS() ...

Function isWorkingMoment(d)
free = isFreeDAY(d) or isHolyDAY(d) or not isInsideHOURS(d)
isWorkingMoment = not free
end function

and at the end, but put it on top,
make the final function,
where you can easily see the flow of your logic:

function CalcBusinessHours() ...

===============

Depending on your platform,
I use VBS on ASP [so am not into that 'ByVal' thing],
you can hide the whole process inside
a serverside include making a "black box of black boxes"
that can and has been tested and debugged outside your application.

<%
' the following include has CalcBusinessHours()
' the parameters are ....
%>
<!-- #include virtual ="/../inc/CalcBusinessHours-Include.asp"-->
Post by d***@gmail.com
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 =
"9: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( "d", sStart ) & "/" & DatePart(
"m", sStart ) & "/" & DatePart( "yyyy", sStart )
If DatePart( "h", sStart ) = 0 And DatePart( "n", sStart
) = 0 Then sStart = sStartDate & " 0:00"
sEndDate = DatePart( "d", sEnd ) & "/" & DatePart(
"m", 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 = "9:00"
sStartDate = DateAdd( "d", 2, sStartDate)
sStart = sStartDate & " " & sStartTime
ElseIf iWeekDay = 1 Then
sStartTime = "9: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( "d", sEnd ) & "/" & DatePart( "m",
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 = "9:00"
sEndDate = DateAdd( "d", 2, sEndDate)
sEnd = sEndDate & " " & sEndTime
ElseIf iWeekDay = 1 Then
sEndTime = "9: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 = "9: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 = "9:00"
sStart = sStartDate & " " & sStartTime
End If
session("test")="sStart:" & sStart & " sDiff:" & sDiff
'*** If End Before Busineess Hours Adjust End Time to Beginning
of Business Hours ***
sDiff = DateDiff( "n", sBusinessDayBegin, sEndTime )
If sDiff < 0 Then
sEndTime = "9: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 = "9: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 = "9: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
--
Evertjan.
The Netherlands.
(Please change the x'es to dots in my emailaddress)
Loading...