Time difference testing

After reading some of the comments on Calculate Working Hours in VBA, I went back and reworked the TimeDiff function. Below is the new and improved WorkingHoursDiff function!

The only requirement is that the start date and end date have to be actual working days. In other words, don't pass weekends or holidays to the function as start or end dates. The function returns -999 if an error occurs, for example if the start date is later than the end date.

It seems the original function returns incorrect working hours. For example, if you have a start date of "2/17/09 12:00PM" and an end date of "2/25/09 4:00PM" and given an 8 hour working day (9AM to 5PM), the number of working hours between those dates and times is 52. WorkingHoursDiff correctly returns 52, while TimeDiff returns 44.

The new function has the added benefit of using correctly typed variables.

Function WorkingHoursDiff(StartDateAndTime As Date, _
           EndDateAndTime As Date) As Long

' returns -999 if any errors occur

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:00 AM#
Const Leave As Date = #5:00:00 PM#

' these are US Federal Holidays, in mm/dd/yyyy format
' taken from http://www.opm.gov/Operating_Status_Schedules/fedhol/2009.asp
Dim HolidaysList As Variant
HolidaysList = Array("1/1/2009", "1/19/2009", "2/16/2009", _
                          "5/25/2009", "7/3/2009", "9/7/2009", _
                        "10/12/2009", "11/11/2009", "11/26/2009", "12/25/2009")

' get date portion
Dim StartDate As Date
Dim EndDate As Date
StartDate = Int(StartDateAndTime)
EndDate = Int(EndDateAndTime)

' make sure end date is later than start date
If (StartDate > EndDate) Then
  WorkingHoursDiff = -999
  Exit Function
End If

' make sure we aren't starting or ending on a weekend or holiday
Dim ArrMember As Variant

If (Weekday(StartDate, vbMonday) > 6) Or _
    (Weekday(EndDate, vbMonday) > 6) Then
  WorkingHoursDiff = -999
  Exit Function
End If

' loop through holidays and check if startdate or enddate is one of them
For Each ArrMember In HolidaysList
  If (CStr(ArrMember) = CStr(StartDate)) Or _
       (CStr(ArrMember) = CStr(EndDate)) Then
    WorkingHoursDiff = -999
    Exit Function
  End If
Next ArrMember

' get time portion
' http://www.bygsoftware.com/issues/modbug.html
Dim ModStartTime As Date
Dim ModEndTime As Date
ModStartTime = StartDateAndTime - 1 * Int(StartDateAndTime / 1)
ModEndTime = EndDateAndTime - 1 * Int(EndDateAndTime / 1)

' if same day, make sure start time is earlier than end time
If (StartDate = EndDate) Then
  If (ModStartTime > ModEndTime) Then
    WorkingHoursDiff = -999
    Exit Function
  End If
End If

' it's the same day, just calculate simple hours diff
If (EndDate - StartDate) < 1 Then
  WorkingHoursDiff = HoursPerDay * (ModEndTime - ModStartTime)
  Exit Function
End If

' loop through days and sum only business days
Dim DaysCount As Long
Dim bWasFound As Boolean
Dim lCounter As Date
For lCounter = StartDate To EndDate
  If Weekday(lCounter, vbMonday) < 6 Then ' it's a weekday
    For Each ArrMember In HolidaysList
      ' reset to false
      bWasFound = False
      If CStr(ArrMember) = CStr(lCounter) Then
        bWasFound = True
        Exit For
      End If
    Next ArrMember

    If Not bWasFound Then
      DaysCount = DaysCount + 1
    End If
  End If
Next lCounter

' check for no business days in date range
If (DaysCount = 0) Then
  WorkingHoursDiff = -999
  Exit Function
End If

' number of hours per day, based on constants defined above
Dim WorkingHoursPerDay As Long
WorkingHoursPerDay = HoursPerDay * (Leave - ComeIn)

' number of hours on the first and last days
Dim BeginningHours As Long
BeginningHours = WorkingHoursPerDay - (HoursPerDay * (ModStartTime - ComeIn))
Dim EndingHours As Long
EndingHours = WorkingHoursPerDay - (HoursPerDay * (Leave - ModEndTime))

If DaysCount = 2 Then ' one day difference
  WorkingHoursDiff = (BeginningHours + EndingHours)
  Exit Function
End If

' subtract start and end dates from count (2 days), multiply by working hours
' to get number of full working hours between start and end dates, plus the
' amount of time worked on the first and last days
WorkingHoursDiff = _
        ((DaysCount - 2) * WorkingHoursPerDay) + (EndingHours) + (BeginningHours)

End Function

You might notice a slightly different algorithm for this function: no more ATP VBA functions. It's just straight up math this time. The inline comments should explain how it works, but let me know in the comments below if you need clarification.

Related Articles:

• June 24, 2008 -- Calculate Working Hours in VBA
• August 27, 2010 -- Calculate Working Hours In Reverse
• January 23, 2008 -- Formula for Date/Time Subtraction in Excel