Calculating Due-date and time, Workdays, with specific work hours?

Been there, done that. Here is a module that contains a function called WorkHours. You can use this as a formula in a cell.

WorkHours(StartDate As Date, NumHours As Double, StartShift As Date, EndShift As Date, Optional Holidays As Range)
StartDate is the date and time of the start of the project.
NumHours is the number of hours estimated for the project
StartShift is the time of day for shift start
EndShift is the time of day for shift end.
Holidays is an optional range containing the dates of holidays.

The result is a date and time when the project will be completed and this should be within working hours.

Function WorkHours(StartDate As Date, NumHours As Double, StartShift As Date, EndShift As Date, _
    Optional Holidays As Range) As Date
Dim StartDay As Date            ' Start of the workday
Dim EndDay As Date              ' End of the workday
Dim EndTime As Date             ' Ending time of project
Dim EndDate As Date             ' Ending date of project

' Intitalize variables
EndTime = StartDate + NumHours / 24
EndDate = Int(StartDate)
StartDay = EndDate + StartShift
EndDay = EndDate + EndShift

' Calculate whole days
While EndTime > EndDay ' while the end time exceeds end of current day
    
    If IsWorkday(StartDay, Holidays) = False Then
    ' If it is a weekday or holiday, push the days and due day up by a day and do nothing else
        StartDay = StartDay + 1
        EndDay = EndDay + 1
        EndTime = EndTime + 1
    Else
    ' If it is a workday, push the day up, but keep due the same
        EndDay = EndDay + 1
        If NumHours > 24 * (EndShift - StartShift) Then
        ' If you need more hours than is in a day, decrement the hours and push up the start date
            NumHours = NumHours - 24 * (EndShift - StartShift)
            StartDay = StartDay + 1
        End If
        If IsWorkday(StartDay, Holidays) = False And NumHours > (EndShift - StartShift) Then
           EndTime = EndTime + 1
        End If
    End If
Wend

WorkHours = StartDay + NumHours / 24

End Function

Function IsWorkday(MyDate As Date, Optional Holidays As Range) As Boolean
Dim cl As Range
Dim bRtn As Boolean
Dim WkDay As Long

bRtn = True

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

WkDay = Weekday(MyDate, vbMonday)

If WkDay > 5 Then
    bRtn = False
End If

IsWorkday = bRtn
       
End Function

First of all, the code should be in a macro-enabled workbook (XLSM or XLSB).

Open the VB Editor (Alt-F11). Click on Insert -> Module and copy and paste the code in.

Then you can use it as a regular formula in a cell like so: =WorkHours(A3,B3,7/24,16/24,Holidays)
Cell A3 is the start time
Cell B3 is the number of hours
7/24 is the start time of the shift.
16/24 is the end time of the shift.
Holidays is a range containing the dates of holidays observed by your company. This argument is optional.

The reason we divide the 7 and 16 by 24 is because Excel measures days as whole numbers since Jan 1, 1900 and the time part of date/time is a fraction so 12 hours is 0.5 days, etc. I'm not going to work out what 7/24 is, so I'll let excel do that. You could just as easily entered 7 AM into a cell, and then read the cell - in this case, you would not have to divide by 24 since Excel would have already done that.

Posting the attachment since the site crashed during the upload.

I apparently did not test this function that well. It should use 7 hours out of the first day (16 -9) leaving 8 hours into the second day 7 + 8 = 15:00, so it does have the wrong time. However, the time does change when you change the hours. I'll have to figure out where the two hour difference happens.

Originally Posted by dflak

I apparently did not test this function that well. It should use 7 hours out of the first day (16 -9) leaving 8 hours into the second day 7 + 8 = 15:00, so it does have the wrong time. However, the time does change when you change the hours. I'll have to figure out where the two hour difference happens.

I also tried getting it to be using start / stop times from two different cells. This kind of works, but gives the wrong calculation sometimes. Havn't figured out at what times this happens. (Sometimes it also gives finishing time outside of work hours).


It also would be great (but propably advanced) if it was possible to adjust times for different days in the week (in Mondays we have maintenance of the machine and on fridays we have different shift-times).
But if this is to complicated we can work around it.
(And perhaps calculate for brakes also?)


/Jocce

Double post, sorry.

I'm working on a priority project. I'll get back to this early next week. I thought I had this worked out, but apparently not. I suspect it will be a minor change to the code.

Waiting for one of my programmers to come back from lunch.

I think I got it working. Use the same syntax as you did before. Attached is my QA workbook. It demonstrates "hopping over" the Thanksgiving holiday (as defined in the holiday table) and also skipping the weekend.

Option Explicit
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

P.S. Columns A,B and D are the only ones worth looking at in the QA workbook. The other columns were intermediate steps in development. Ignore them.