Calculate Working Hours in VBA

June 24, 2008 – 12:02 pm by JP

In the spirit of my last post Calculate Working Days Minus Holidays in VBA, here is a function I wrote recently that returns the number of working hours between two date/time values passed to the function as arguments. It is self-contained and works independently of whatever existing code you have, so it is a true "drop-in" code you can use anywhere you need it.

It is based on the code I posted, as well as from OzGrid which had a good thread about calculating working hours. I adapted that code to work in VBA.

A lot of spreadsheets contain date/time data, on which you might need to determine turnaround, for example, how long something took to ship.

For simple calculations that don't require excluding non-working hours, you might try something like the formula in Formula for Date/Time Subtraction in Excel, but for batch processing, or where you need to exclude non-working hours, this function can be used on the worksheet or in VBA to return the difference in working hours between two dates.

This is based on a 8 hour workday, but you can adjust as needed. The UDF uses some less-than-ideal type conversion (Variant), which I admit isn't my first choice for how to construct UDFs. But since it returns the correct answer, I'm willing to let it go for now.

As with Calculate Working Days Minus Holidays in VBA, you will need to set a reference to the ATP (Analysis Tool-Pak) VBA library in order to use the NETWORKDAYS function. You may also need to go to Excel > Tools > Add-Ins and add the ATP VBA Add-In. Details are in the previous post link.

plain text version

VBA:

Private Function TimeDiff(StartTime As Variant, EndTime As Variant) As Variant
'
' calculates time different between two dates/times provided as arguments
' i.e. "1/1/2008 12:00 AM" and "1/13/2008 10:33 AM"
'
' based on 8 hour workday, excluding holidays and weekends and non-working hours
'
Dim StartDate As Date
Dim EndDate As Date
Dim ModStartTime As Date
Dim ModEndTime As Date
Dim DaysWorked As Long
Dim HolidaysList()
Const HoursPerDay As Integer = 24
' 24-hour military time, edit as needed
' if you want to set different working hours
Const ComeIn As Date = "9:00"
Const Leave As Date = "17:00"
' list of federal holidays in 2007 and 2008
' add or remove as you see fit
' you will need to add 2009 holidays as well
' remove ones you aren't using
HolidaysList = Array("1/1/2007", "1/15/2007", "2/19/2007", "5/28/2007", "7/4/2007", "9/3/2007", "10/8/2007", "11/12/2007", _
"11/22/2007", "12/25/2007", "1/1/2008", "1/21/2008", "2/18/2008", "5/26/2008", "7/4/2008", "9/1/2008", "10/13/2008", _
"11/11/2008", "11/27/2008", "12/25/2008")
StartDate = Int(StartTime)
EndDate = Int(EndTime)
' http://www.bygsoftware.com/issues/modbug.html
ModStartTime = StartTime - 1 * Int(StartTime / 1)
ModEndTime = EndTime - 1 * Int(EndTime / 1)
If (EndDate - StartDate) <1 Then
' it's the same day, just calculate simple hours diff
TimeDiff = Format(HoursPerDay * (ModEndTime - ModStartTime), "####.####")
Else
' adapted from http://www.ozgrid.com/News/apr-2008.htm
TimeDiff = (networkdays(StartDate, EndDate, HolidaysList) - 1) * (HoursPerDay * (Leave - ComeIn)) - _
(HoursPerDay * (Leave - ModEndTime)) - (HoursPerDay * (ModStartTime - ComeIn))
End If
End Function

I call your attention to the last line that does the heavy lifting:

plain text version

VBA:

TimeDiff = (networkdays(StartDate, EndDate, HolidaysList) - 1) * (HoursPerDay * (Leave - ComeIn)) - _
(HoursPerDay * (Leave - ModEndTime)) - (HoursPerDay * (ModStartTime - ComeIn))

I run the standard NETWORKDAYS function to calculate the number of non-holiday and non-weekend days between the two inputted dates, then subtract one because the function counts the start date as the first date, and we want number of elapsed days. We multiply that by the number of hours per day, which we defined at the beginning of the sub. Now we need to subtract the hours from the first and last day that don't count towards the total.

For example, if the start time was 12pm, and our workday starts at 9, then we need to remove three hours from the total, because we didn't start at 9am on the first day, hence: (HoursPerDay * (ModStartTime - ComeIn))

If the end time was 4pm, and our workday ends at 5pm, we need to subtract one hour from the total, because we didn't end at 5pm on the last day, ergo: (HoursPerDay * (Leave - ModEndTime))

You might notice that the formula doesn't account for when the end time is outside of working hours, well, that's why it's called calculating working hours, if you need to calculate past that, simply expand the range of the ComeIn and Leave constants to include whatever times you think you'll need.

You will note that the times are multiplied by 24 to return a true hours amount, rather than a decimal representation of a fraction of a day. Otherwise you end up with results like ".26 days" instead of "6 hours". To accomplish this, I used another constant "HoursPerDay" to avoid the magic number problem.

Usage:

In Excel:

=TimeDiff(A1,B1)

In VBA:

plain text version

VBA:

Dim StartDateAndTime as Date
Dim EndDateAndTime As Date
Dim vTime As Variant
StartDateAndTime = Range("A1").Value
EndDateAndTime = Range("B1").Value
vTime = TimeDiff(StartDateAndTime, EndDateAndTime)

Remember your input values should be date AND time, otherwise VBA just assumes a time of 12:00:00 AM, which is probably not what you meant.

Enjoy,
JP

ps- For you Excel charting and modeling fans, Jon Peltier (Excel MVP) is having a contest on his blog, if you have developed a scientific or engineering model in Excel, submit it and maybe it will pay off. Well, you already knew that because you already read his blog, right?

Share and Enjoy:

Print This Post |

Email This Post | Permalink |

Subscribe now!

Filed Under: Excel, UDF, VBA
Tags: Excel, function, MOD, networkdays, time difference, VBA, working hours

This post has 3,284 views since June 24, 2008 – 12:02 pm.

9 Responses to “Calculate Working Hours in VBA”
Well does not work. Cant addin the atp reference as it is simply not there.. I try everything from the MS office help files to add it without success.

By Yvan Dagenais on Jul 3, 2008
Yvan, you probably have to go to Excel > Tools > Add-Ins and add the ATP VBA Add-In first. Then you can go to the VB Editor and set a reference to atpvbaen.xls.

By JP on Jul 3, 2008
Thanks for the tip however I alredy tried that and it says that it is in Excel (do you want to replace etc..)

By Yvan Dagenais on Jul 4, 2008
Sorry, I'm still not sure what you mean. Did you check out some other sites that explain in more detail how to add the ATP VBA functions? For example:

http://www.cpearson.com/excel/ATP.htm
http://support.microsoft.com/kb/125949

Both of these sites explains how to do so.

HTH,
JP

By JP on Jul 4, 2008
Again, thanks for your feedback.

I followed the instructions to add the ATP function to Access 2003 and it simply does not appear in the reference listing.

So I had to improvise and devise my own coding to calculate working hours accounting for weekends and holidays. There is still work to do but it is a start

Option Compare Database
Option Explicit

' Goal is to calculate the number of working Mins between a Start Date and a End Date.
' The working Mins are set to be between 8:30 AM and 5:00 PM
' The calculation is to account for holidays dates located in a table named "tblholidays" in Access
' The fields in access are named "holdate" and "holname", the latter for reference only

Public Function NetWorkMins(dteStart As Date, dteEnd As Date) As Single

' The function is called with "NetWorkMins ([dteStart],[dteEnd])" which would give the differential in Minutes
' or it can be called with "NetWorkMins ([dteStart],[dteEnd])/60" for a result in Hours

Dim intGrossDays As Single
Dim intGrossMins As Single
Dim intStartGrossMins As Single
Dim intEndGrossMins As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Single
Dim StartDayMins As Single
Dim EndDayMins As Single

' This resets the function result and the nonWorkdays variable

NetWorkMins = 0
nonWorkDays = 0

' Need to see if either dteStart or DteEnd falls on a weekend or holiday.

' Bring dteStart to the last friday at 5PM

If Weekday(dteStart) = 7 Then
dteStart = dteStart - 1
dteStart = DateValue(dteStart) + TimeValue("5:00pm")
End If

If Weekday(dteStart) = 1 Then
dteStart = dteStart - 2
dteStart = DateValue(dteStart) + TimeValue("5:00pm")
End If

' Bring dteStart to the day before the holiday date at 5PM

If dteStart = DLookup("[HolDate]", "tblholidays", _
"[HolDate] = datevalue('" & Format(dteCurrDate, "m/d/yyyy") & "')") Then
dteStart = dteStart - 1
dteStart = DateValue(dteStart) + TimeValue("5:00pm")
End If

' Need to repeat as the possibility of 2 holiday in a row exists

If dteStart = DLookup("[HolDate]", "tblholidays", _
"[HolDate] = datevalue('" & Format(dteCurrDate, "m/d/yyyy") & "')") Then
dteStart = dteStart - 1
dteStart = DateValue(dteStart) + TimeValue("5:00pm")
End If

' Bring dteEnd to the next Monday at 8:30 AM

If Weekday(dteEnd) = 7 Then
dteEnd = dteEnd + 2
dteEnd = DateValue(dteEnd) + TimeValue("8:30am")
End If

If Weekday(dteEnd) = 1 Then
dteEnd = dteEnd + 1
dteEnd = DateValue(dteEnd) + TimeValue("8:30am")
End If

' Bring dteEnd to the day after the holiday date at 8:30 AM (wont work if 2 holiday in a row)

If dteEnd = DLookup("[HolDate]", "tblholidays", _
"[HolDate] = datevalue('" & Format(dteCurrDate, "m/d/yyyy") & "')") Then
dteEnd = dteEnd + 1
dteEnd = DateValue(dteEnd) + TimeValue("8:30am")
End If

' Need to repeat as the possibility of 2 holiday in a row exists

If dteEnd = DLookup("[HolDate]", "tblholidays", _
"[HolDate] = datevalue('" & Format(dteCurrDate, "m/d/yyyy") & "')") Then
dteEnd = dteEnd + 1
dteEnd = DateValue(dteEnd) + TimeValue("8:30am")
End If

' This sets the time the day starts and days end, which takes the value of the dteStart without the hours
' And add 8:30 AM at the end of the date string
' And sets the time the day ends, which takes the value of the dteEnd without the hours
' And add 5:00 PM at the end of the date string

WorkDayStart = DateValue(dteStart) + TimeValue("8:30am")
WorkDayend = DateValue(dteEnd) + TimeValue("5:00pm")

'Calculate total Mins and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd)) + 1

' Calculates the number of days ("d")between dteStart and dteEnd with DateDiff function
' The "+1" is required to obtain an accurate calculation
' The "gross" name is due to the fact that the holidays are not yet removed from the calculation

For i = 1 To intGrossDays

' Weekday function below verifies if each of the days between (and including) the dteStart and dteEnd
' Are Sundays (value = 1) or Saturdays (value = 7)
' This is done by assigning "i" as a variable = 1 to the number of days between the dteStart
' And dteEnd as determined above ("intGrossDays")starting with "i" = 1 for the 1st day
' Then with "Next i" creating a loop to go through each of the number of days determined in "intGrossDays"
' The variable "dteCurrDate" is the date that is verified and changes at every loop of "i"

dteCurrDate = DateAdd("d", i - 1, DateValue(dteStart))

' Weekday function below verifies if each of the days between (and including) the dteStart and dteEnd
' are Sundays (value = 1) or Saturdays (value = 7) or on the list of holiday dates on "tblholidays"
' The If - Then if positive skips to the last End If (before the Next i) thus does not store the netWorkMins value

If Weekday(dteCurrDate) 1 And Weekday(dteCurrDate) 7 _
And IsNull(DLookup("[HolDate]", "tblholidays", _
"[HolDate] = datevalue('" & Format(dteCurrDate, "m/d/yyyy") & "')")) Then

' The following deals with working days only as holidays/weekends were eliminated just before.

If (intGrossDays = 1) Then

' This is in the case of the number of working days is = 1
' and confirms that the start and end date are in the same day
' thus can use the standard DateDiff command to calculate the number of minutes between start and end.

intGrossMins = DateDiff("n", (dteStart), (dteEnd)) '# of minutes between dtsStart and dteEnd
StartDayMins = DateDiff("n", dteStart, WorkDayStart) '# of minutes between dteStart and WorkDatStart
EndDayMins = DateDiff("n", WorkDayend, dteEnd) '# of minutes between dteEnd and WorkDayEnd

If (StartDayMins >= 0) Then 'if dteStart was before WorkDayStart
intGrossMins = intGrossMins - StartDayMins
End If

If (EndDayMins >= 0) Then 'if dteEnd was after WorkDayEnd
intGrossMins = intGrossMins - EndDayMins
End If

If (intGrossMins > 510) Then ' If both dteStart and dteEnd are outside working Mins
intGrossMins = 510
End If

ElseIf (intGrossDays > 1) Then 'This is applicable when intGrossDays not = 1 when several working days are included.

If (Format(dteStart, "m/d/yyyy") = Format(dteCurrDate, "m/d/yyyy")) Then
' To capture the dteStart

StartDayMins = DateDiff("n", WorkDayStart, dteStart)
'if negative then dteStart earlier than WorkDayStart
'if positive then dteStart is later than WorkDayStart

If StartDayMins >= 0 Then ' If dteStart was after WorkDayStart
intStartGrossMins = 510 - StartDayMins

Else

intStartGrossMins = 510 ' dteStart was before WorkDayStart thus maximum # of minutes = 510

End If

End If

' To capture the dteEnd
If (Format(dteEnd, "m/d/yyyy")) = (Format(dteCurrDate, "m/d/yyyy")) Then

EndDayMins = DateDiff("n", dteEnd, WorkDayend)
'if negative then dteEnd is later than WorkDayEnd
'if positive then dteEnd is earlier than WorkDayEnd

If EndDayMins >= 0 Then ' If dteEnd was before WorkDayEnd
intEndGrossMins = 510 - EndDayMins

Else

intEndGrossMins = 510 ' dteEnd was after WorkDaYend thus maximum of minutes = 510

End If

End If

' In the case of multiple days, this removes the days that are dteStart or dteEnd
' and gives them the maximum number of minutes per day

If (Format(dteStart, "m/d/yyyy")) (Format(dteCurrDate, "m/d/yyyy")) And _
(Format(dteEnd, "m/d/yyyy")) (Format(dteCurrDate, "m/d/yyyy")) Then

intGrossMins = intGrossMins + 510

End If

End If

End If

Next i

NetWorkMins = intGrossMins + intStartGrossMins + intEndGrossMins

If NetWorkMins < 0 Then
NetWorkMins = 0

End If

End Function

By Yvan Dagenais on Jul 4, 2008
I'd love to help, but Access is my weak spot. I wouldn't even know how to assist (without learning Access from the bottom up).

Sorry!

By JP on Jul 7, 2008
Hi,

This is exactly what I've been looking for and it's great!

Btw, just 1 minor issue. My start & end dates are:

Start Date: 09/06/2008 13:30
End Date: 10/06/2008 18:01
Result: 4.516666667
Correct result: 1 days 4 hrs 31 mins

How come the "1 day" is missing? Can help?

Thanks in advance!

By Paul on Sep 9, 2008
The format of the dates in the code is mm/dd/yyyy and your example is dd/mm/yyyy..

That is probably the error

By Yvan Dagenais on Sep 9, 2008
Paul,
Are you using the dd/mm/yyyy format? The code is designed for US dates (mm/dd/yyyy). You'll need to adjust the values in the HolidaysList array to match the date format used in your country. I should have mentioned that in the original post.

--JP

By JP on Sep 9, 2008