Calculate Working Hours in VBA
June 24, 2008 • JP • 31 Comments • Rate This Article
• Links to this article
(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.
'
' 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:
(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:
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?
Excel ·
Rate This Article:
(No Ratings Yet)
Loading ...What now?
Subscribe To The Blog
Email This Article
Follow Me On Twitter
My Facebook Page
Or just keep reading:
I'm just an average guy who writes VBA code for a living. This is my personal blog. Excel and Outlook are my thing, with a sprinkle of Access and Word here and there. Follow this space if you want to learn more about VBA. Keep Reading »
Previous Post: Calculate Working Days Minus Holidays in VBA
Next Post: Format header row
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.
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.
Thanks for the tip however I alredy tried that and it says that it is in Excel (do you want to replace etc..)
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
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
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!
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!
The format of the dates in the code is mm/dd/yyyy and your example is dd/mm/yyyy..
That is probably the error
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
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!
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.
Definitely, the format of the code is for mm/dd/yyyy.
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!
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
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?
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))
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!
Post away! You might also want to show your formula as well.
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.
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)
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.
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.
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)
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:
'
' 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
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
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
Hi,
Can this formula be modified to calculate a work day of 8:00am until 5:00pm excluding lunch time from 12:00pm to 1:00pm?
Thanks,
Whitney
It is possible to enter your normal Working Hours in Outlook, in the general Calendar settings (at least in the new 2010 version, but I think in 2007 also). Is there a way to read this schedule from Outlook VBA in order to automatically determine the normal working hours as specified there, without having to manually specify what they are?
I'll check it out.
Thanks! Would be so cool to be able to do! I'm still searching too, will post here to update if I find a way before I hear back.
You can retrieve default start and end time from the registry. Check out the following registry key:
HKCU\Software\Microsoft\Office\11.0\Outlook\Options\Calendar
Of course, you'll change 11.0 to reflect your version number (Outlook 2003 is 11.0, 2007 is 12.0 and so on).
Look for the DWORD values "CalDefStart" and "CalDefEnd"
The challenge will be to interpret the DWORD values into something meaningful. You'll need to adjust the values and see how the DWORD values change, to make some kind of conversion algorithm.