Fill dates based on estimated hours

Question

I need to fill start and end dates based on the estimated hours available for the tasks.

Total hours should be 7 and not more than that for a working day. If I supply a start date in cell D2 then the macro will automatically put dates for the below cells.

In my coding when I get the total hours of more than 7 for a day it gives me the wrong dates.

Worksheet code

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("D2")) Is Nothing Then
        Application.EnableEvents = False
        Call ThisWorkbook.ProjectMgmt(Target)
        Application.EnableEvents = True
    End If
End Sub

Thisworkbook code

Sub ProjectMgmt(Target As Range)

Dim stDate, enDate As Date, sTime, eTime, tTime As Long
tTime = 7

Target.Select
stDate = ActiveCell.Value

eTime = ActiveCell.Offset(0, -1).Value

Do
    If eTime < tTime Then
        ActiveCell.Value = stDate
        ActiveCell.Offset(0, 1).Value = stDate
    ElseIf eTime = tTime Then
        ActiveCell.Value = stDate
        ActiveCell.Offset(0, 1).Value = stDate
        ' need to zero the time value
        eTime = 0
        
        stDate = Application.WorksheetFunction.WorkDay_Intl(stDate, 1, 1, Worksheets("HolidayList").Range("B3:B16"))
        
    ElseIf eTime > tTime Then
        ActiveCell.Value = stDate
        ' need to check time for add end date
        stDate = Application.WorksheetFunction.WorkDay_Intl(stDate, 1, 1, Worksheets("HolidayList").Range("B3:B16"))
        ActiveCell.Offset(0, 1).Value = stDate
        eTime = eTime - tTime
    'Else
    '    MsgBox "that theriyalaye moment"
    End If
    ActiveCell.Offset(1, 0).Select
    eTime = eTime + ActiveCell.Offset(0, -1).Value

Loop Until Range("C" & ActiveCell.Row).Value = ""

End Sub

Sample image

Answer 1

So, rather than leaping straight into VBA, how about we start by putting formulas in to calculate what you want? We can proceed to automation by filling the formulas after we get the calculations right.

You are starting with a set of tasks each with some number of hours to complete and an initial start date like this,

You wish to add start and end dates for each of the tasks based on a 7 hour day.

Starting with Task 1's end date, divide the number of hours in C2 by 7 and add that many days to the date in D2. The formula in E2 is =WORKDAY($D2,INT(($C2-1)/7),holidays!$B:$B). The minus 1 is because if we exactly fill up a day, we don't want to advance the date. So, Int(3/7) is zero and the end date is the same as the start date.

Now for Task 2's Start date, we sum up ALL the hours spent to this point, divide by 7, and add that many work days to the Start Date in $D$2. The formula in D3 is =WORKDAY($D$2,INT(SUM($C$2:$C2)/7),holidays!B:B). The dollar sign cell anchors are important here to get Fill Down to work right.

Now for Task 2's End Date and then we're done with the hard part. The Start Date already has 0 to 6 hours consumed from the prior tasks. The best way to calculate that is to sum ALL the prior hours and get the remainder when divided by 7. Then add the hours needed to complete the task, integer divide by 7 and add that many days to the Start Date. The formula is: =WORKDAY($D3,INT((MOD(SUM($C$2:$C2),7)+$C3-1)/7),holidays!B:B). Once again the dollar sign cell anchors are important to get Fill Down to work.

At this point, your sheet looks like this:

Now all that's done just highlight D3 and E3 and fill down to the rest of your tasks, like this:

Now that pretty much gets the dates right. Notice that Task 5 ends on 12/23 and Task 6 begins on 12/26. This is correct because Task 5 fills up ALL the hours on 12/23, Task 6 cannot begin until the next work day.

As far as further automation goes, the formulas will automatically recalculate the dates if you change the top start date or if you adjust any Task hours, no VBA needed. The only extra intervention is when you add extra tasks. But that only requires a formula fill down.