Calculate Working Hours in VBA
Posted June 24, 2008 – 12:02 pm by JP in Excel, UDF, VBA
(Update 3/25/2009: See Time Difference Testing for an updated version of the code found below.)
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 from that post, 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.
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 | 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:
1 2 | 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:
1 2 3 4 5 6 7 8 | 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?
Tags: Excel, function, MOD, networkdays, time difference, VBA, working hours
If you enjoyed this post, make sure you 
Comments RSS
26 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
Hi!
Thank you for this excellent function!
However I'm having problems with it.
I've tried to modify this to my needs but somehow nothing seems to work. It just gives #VALUE as a result. I've changed the HolidayList to my country's holidays for 09 and changed ComeIn and Leave to "08:00″ and "00:00″.
My dates are in "dd/mm/yyyy hh:mm" format. Could this be the cause?
Any help would greatly be appreciated!
By Martin on Feb 26, 2009
Martin,
You'll need to set a reference to the Analysis ToolPak VBA functions, in order to use the NETWORKDAYS function in your VBA code.
See Calculate Working Days Minus Holidays in VBA for instructions on how to do that.
Let me know if it still doesn't work.
By JP on Feb 26, 2009
Definitely, the format of the code is for mm/dd/yyyy.
By Yvan Dagenais on Feb 26, 2009
Thank you both for the quick replies!
I feel like such a noob 
I've finally figured out what the problem was! For some reason I declared TimeDiff as an Object and not as Variant.
Thank you so much for your help!
By Martin on Feb 26, 2009
Glad to hear it worked out for you. My next step was going to be to ask you to post your code, so I might have spotted that
By JP on Feb 26, 2009
Hi!
Sorry to bother you again. But there's still one thing I don't get. Is there any way I can multiply the decimal (".####") by 60, so I get the result as time ("hh:mm") instead of a general number?
By Martin on Feb 27, 2009
Sure Martin. Just use this formula:
=MOD(TimeDiff(A1,B1),1)*60
Instead of
=TimeDiff(A1,B1)
And of course this will return just the integer portion:
=INT(TimeDiff(A1,B1))
By JP on Feb 27, 2009
Hi JP!
Many thanks for all the help you've given me!
A little more help needed from you, still, if possible. I'm missing the elapsed days, just as Paul did in an earlier post. But unlike him, I get #VALUE! as a result. When only hours and minutes elapsed then the result is fine. My date format is "dd/mm/yyyy" (I've changed the dates in the HolidayList array, same date format).
I'll post the code, if you prefer. I really need this to be up and running by the end of the week. :S
Thank you for your assistance!
By Martin on Mar 10, 2009
Post away! You might also want to show your formula as well.
By JP on Mar 10, 2009
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
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
Const ComeIn As Date = "08:00"
Const Leave As Date = "23:59"
'Hungarian national holiday list for 2009
HolidayList = Array("13/04/2009", "01/05/2009", "01/06/2009", "20/08/2009", "21/08/2009", "23/10/2009", "24/12/2009", "25/12/2009")
StartDate = Int(StartTime)
EndDate = Int(EndTime)
ModStartTime = StartTime - 1 * Int(StartTime / 1)
ModEndTime = EndTime - 1 * Int(EndTime / 1)
If (EndDate - StartDate) < 1 Then
TimeDiff = Format(HoursPerDay * (ModEndTime - ModStartTime), "####.####", vbMonday, vbUseSystem)
Else
TimeDiff = Application.Run(atpvbaen.xla!networkdays(Format(HoursPerDay * (ModEndTime - ModStartTime)) - 1) * (HoursPerDay * (Leave - ComeIn)) - _
(HoursPerDay * (Leave - ModEndTime)) - (HoursPerDay * (ModStartTime - ComeIn)))
End If
End Function
My formula is simply =TimeDiff(A1,B1). I changed nothing else but the HolidayList array. Please tell me what I'm missing.
By Martin on Mar 11, 2009
Why are StartTime and EndTime objects? Also, you might have to add the Analysis Toolpak VBA functions by going to Tools » Add-Ins and making sure "Analysis Toolpak VBA" is checked. That would serve the dual purpose of allowing you to use ATP functions in VBA and freeing you from the requirement of qualifying the method calls with the add-in name.
Also, are you calling the function from the same workbook as the code? If not, you need to qualify the method call in the formula. For example, if you put the code in personal.xls, you need to enter the formula like this:
=PERSONAL.XLS!TimeDiff(A1,B1)
By JP on Mar 11, 2009
Martin, I'm posting an updated version of the function, check out the latest post from today and see if that helps. You won't need to use ATP at all.
By JP on Mar 12, 2009
Looking for some help – still very new to VBA. I got the code copied, my start time and open time and holidays all inputted, but not sure what to do next, as it's not a standard macro (as far as I can tell!). I have activated the add-in as well, as you instructed.
I have a date/time in columns A, B, & C. I need to calculate 3 TAT (turnaround time) values:
A to B, B to C, and A to C.
How do I get the values to show up in columns D, E, and F?
This is probably a basic user question, but I would really appreciate any direction you can provide.
By Cynthia on Apr 3, 2009
Cynthia,
Assuming your values were placed in A1, B1 and C1:
Column D would be
=TimeDiff(A1,B1)
Column E would be
=TimeDiff(B1,C1)
Column F would be
=TimeDiff(A1,C1)
By JP on Apr 3, 2009
HI Again,
I figured out how to get the results in the appropriate cells; this being said, I am now getting the infamous #VALUE result. I am working with Excel 2007. I went to the Office Button, clicked on the Excel Options button, went to Add-Ins, and selected the Analysis tool Pak VBA, which now shows as an Active Application Add-In. I then went into the VBE, and went to Tools>References> and checked beside atpvbaen.xls. My code is in the same workbook as my formula. Help! Here is my code:
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
'
' 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 2009
' add or remove as you see fit
' you will need to add additional year's holidays as well
' remove ones you aren't using
HolidaysList = Array("10/13/2008", "11/11/2008", "11/27/2008", "12/25/2008", "1/1/2009", "1/19/2009", "2/16/2009", "5/25/2009", "7/4/2009", "9/7/2009", "10/12/2009", "11/11'2009", "11/26/2009", "12/25/2009")
'October 13, 2008
'November 11, 2008
'November 27, 2008
'December 25, 2008
'January 1, 2009
'January 19, 2009
'February 16, 2009
'May 25, 2009
'July 4, 2009
'September 7, 2009
'October 12, 2009
'November 11, 2009
'November 26, 2009
'December 25, 2009
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
End Function
By Cynthia on Apr 3, 2009
I think you should use the new version of this function. I rewrote it so you don't need to reference any libraries, and it's more accurate. Here's a link:
Time Difference Testing
By JP on Apr 3, 2009
Hi,
I hv 1 minor issue.Need to calculate the value for 2 date
Start Date: 5/31/2009 13:30
End Date: 6/1/2009 18:01
i require the result in HH:MM
this is to calculate the working hours
exceeding 24 hours or less
seek yr support
Thanks in advance
By Praba on Jun 25, 2009