WorkHours and NetWorkHours are analogous to WorkDays and NetWorkDays except that they compute time in terms of hours taking into effect the gaps caused by non-shift hours, weekend and holidays.

The syntax for the functions are:

WorkHours

WorkHours (Start Date/Time, Number of Hours, Shift Start, Shift End, [Holidays])
  • Start Time is the date/time start of the task,
  • Number of hours is the time the tasks is estimated to take
  • Start Shift is the shift start time
  • End Shift is the shift end time
  • Holidays is an optional argument that points to a range of dates containing the holidays
.

The function returns the completion date/time.

NetWorkHours

NetWorkHours(Start Shift, End Shift, Start Date/Time, End Date/Time, [Holidays])
  • Start Shift is the shift start time
  • End Shift is the shift end time
  • Start Time is the date/time start of the task
  • End Time is the date/time of task completion
  • Holidays is an optional argument that points to a range of dates containing the holidays.

The function contains the number of hours to complete the task.

Function WorkHours(StartDate As Date, NumHours As Double, ShiftStart As Date, ShiftEnd As Date, _
    Optional Holidays As Range) As Date
Application.Volatile
Dim StartDay As Date            ' Start of the workday
Dim EndDay As Date              ' End of the workday
Dim EndHours As Date            ' Ending time of project
Dim EndDate As Date             ' Ending date of project
Dim DayHours As Double          ' Number of hours in the workday
Dim BeginTime As Date           ' Beginning of task or shift

' Initialize variables
EndDate = StartDate + NumHours / 24
EndDay = Int(StartDate) + ShiftEnd
BeginTime = StartDate - Int(StartDate)

' While the end date still exceeds the end of day for a workday
While EndDate > EndDay
    ' increment EndDay
    EndDay = EndDay + 1
    ' Process only for workdays
    If IsWorkday(EndDay, Range("Holidays")) = True Then
        'decrement the hours
        NumHours = NumHours - 24 * (ShiftEnd - BeginTime)
        BeginTime = ShiftStart  ' Begin time becomes shift start after the first day
        ' Compute new enddate
        EndDate = Int(EndDay) + ShiftStart + NumHours / 24
    Else
        ' increment the end date for weekends and holidays without processing
        EndDate = EndDate + 1
    End If
Wend

WorkHours = EndDate
End Function

Function IsWorkday(MyDate As Date, Optional Holidays As Range) As Boolean
Dim cl As Range             ' Pointer to holiday range
Dim bRtn As Boolean         ' Return value (default = True unless proven otherwise)
Dim WkDay As Long

bRtn = True

' Check to see if the date is on the holiday list
If Not Holidays Is Nothing Then
    For Each cl In Holidays
        If Int(MyDate) = cl.Value Then
            bRtn = False
            Exit For
     End If
    Next
End If

' Check to see if the day is a weekend
WkDay = Weekday(MyDate, vbMonday)

If WkDay > 5 Then
    bRtn = False
End If

IsWorkday = bRtn
       
End Function
Function NetWorkHours(Shift_Start As Date, Shift_End As Date, Start_Time As Date, End_Time As Date, _
    Optional Holidays As Range) As Double
Dim NumHrs As Double
Dim ShiftHrs As Double
Dim DayDiff As Long
Dim DayLoop As Long
Dim DayHoliday As Boolean

ShiftHrs = Shift_End - Shift_Start
NumHrs = 0

' Figure out the number of hours
If Time_Fraction(Start_Time) <= Time_Fraction(End_Time) Then
    NumHrs = Time_Fraction(End_Time) - Time_Fraction(Start_Time)
Else
    NumHrs = (Time_Fraction(Shift_End) - Time_Fraction(Start_Time)) + _
    (Time_Fraction(End_Time) - Time_Fraction(Shift_Start))
End If

' Determine the number of extra days to add
DayDiff = Int(End_Time - Start_Time)
For DayLoop = 1 To DayDiff
    ' check to see if day is a weekend or holiday
    If Holidays Is Nothing Then
        DayHoliday = False
    Else
        DayHoliday = Is_Holiday(Int(Start_Time) + DayLoop)
    End If
    If Weekday(Int(Start_Time) + DayLoop, 2) < 6 And DayHoliday = False Then
        NumHrs = NumHrs + ShiftHrs
    End If
Next DayLoop

NetWorkHours = 24 * NumHrs

End Function

Function Is_Holiday(MyDate As Date) As Boolean
Dim cl As Range                         ' Pointer to Holiday list

' Set to true if date is on the list of holidays
For Each cl In Range("Holidays")
    If MyDate = cl.Value Then
        Is_Holiday = True
        Exit Function
    End If
Next cl

Is_Holiday = False
End Function

Function Time_Fraction(MyTime As Date) As Double
Time_Fraction = TimeSerial(Hour(MyTime), Minute(MyTime), Second(MyTime))
End Function