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.
-
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:
-
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:
-
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?
Print This Post
|
Email This Post
|
Permalink
|
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