Hours to complete a task put into the correct week from start and end dates.

[RichFer]

Hi all,

I have came to another stumbling block.

If i know the number of hours to complete a task. i.e 80 hours. The start date is 01/12/2023 08:00 and the end date is 15/12/2023 11:00, as you can see this will happen over several weeks. Is there a way to get excel to put i.e 38 hours week one from the 01/12/2023 8:00 - 07/12/2023 04:30, 38.5 hours week 2 from 08/12/2023 07:30 - 14/12/2023 04:30, 3.5 hours week 3 from 15/12/2023 07:30 - 21/12/2023 11:00. Also if there are holidays in a particular week, take these into account.

Many thanks in advance.

Rich

[JohnTopley]

Think carefully about the format of "Resource Summary" as you will have projects which run for more than one calendar month (and hence will overlap month ends)

Or if the above situation arises, are you only interested a portion of the total i.e. a .specific month within the project ?

Your example of 120 hours starting on 01/12/2023 at 08:00 will run into January due to the holiday periods

[JohnTopley]

A "prototype" based on the previous macro. When testing - data in E3/F3 of "Resource Requirements" _ all results will go into row 8 of "Resource Summary" which has a RUN button to activate macro

Option Explicit

Sub W2T()

Dim sDate As Date, isDate As Date, Shift_Start As Double, iShift_start As Double, lBreak As Double
Dim dT As Double, wkday As Integer, icol As Integer, n As Integer
Dim res As Variant, bYear As Integer
Dim wkhours As Double, ft As Double, Total_Workhours As Double
Dim Shift_End As Double
Dim wkhrs(1 To 31) As Double

Application.ScreenUpdating = False

sDate = Int(Range("stDate")): Shift_Start = Range("stDate") - sDate              ' Initial Start date and Start time
dT = Range("Duration")                                                           ' Duration (Hours)
bYear = Year(Now)                                                                ' "Base" year for holiday cheking
n = 0
Total_Workhours = 0

Do
    wkday = Weekday(sDate, vbMonday)                                             ' Weekday (1=Monday, 7=Sunday)
                                                              
    If wkday < 6 Then                                                            ' Check if Monday to Friday
        If wkday <= 4 Then                                                       ' Monday to Thursday
            Shift_End = Application.Min(Shift_Start + (dT / 24), 16.5 / 24)      ' Finish time (16:30)
            lBreak = 1 / 48                                                      ' 30 minute lunch break
        Else
             Shift_End = 12 / 24                                                 ' Friday finish (12:00)
             lBreak = 0                                                          ' No lunch break
        End If
     
        n = n + 1                                                                ' increment "day" index
        wkhrs(n) = (Shift_End - Shift_Start - lBreak) * 24                       ' Assign hours for this day
        Total_Workhours = Total_Workhours + wkhrs(n)                             ' Accumulate Total hours
        
    Else
        n = n + 1                                                                ' increment "day" index for weekends
    End If
    
    Do                                                                           ' Check for holidays
        sDate = sDate + 1
        icol = Year(sDate) - bYear + 1                                           ' Holiday year column in range "Holidays"
        res = Application.Match(CLng(sDate), Range("holidays").Columns(icol), 0) ' check if date is a holiday
        If IsNumeric(res) Then n = n + 1                                         ' Increment "day" index if holiday
    Loop While IsNumeric(res)                                                    ' Loop while match found
    
    Shift_Start = 7.5 / 24                                                       ' Standard start time
    
Loop While Round(Total_Workhours, 2) < dT                                                ' Loop while work hours < duration hours

   wkday = Weekday(sDate, vbMonday)
   If (Total_Workhours > dT) Then
        wkhrs(n) = wkhrs(n) - (Total_Workhours - dT)
   Else
        'If wkday > 5 Then n = n + 3 Else n = n + 1
   End If
       
   With Sheets("Resource Summary")
    .[F8].Resize(1, 31) = wkhrs
   End With
   
End Sub

[RichFer]

Hi John,

Thank you again for your reply.

I think i may have a solution by creating helper columns and then creating a "Resource Summary" sheet for each month. The hours put against each week "helper columns" will then go into each individual months sheet and so on. It does not make a lot of difference if i have multiple sheets for each month and will maybe aid me with creating graphs in the long run.

I will let you know how i get on though and if i need more assistance.

Rich

[RichFer]

Hi John,

I have made some progress but still cannot get quite what i am looking for , i hope you can provide me with some assistance.

I have segregated the months into weeks, and have a formula to distribute the hours out across the weeks based on the start and end date, however, i do not think it working quite right and is not taking into account the actual working hours, is there a way for it to recognise this and distribute the hours as they would be in a reality?

I have filled in an example in the first row with the following conditions.

Start Date - 03/01/2023 07:30
end date - 17/01/2023 10:30
Hours - 80

If i have worked it out correctly i should be getting week 1 - 30 Hours, Week 2 - 38.5 Hours and then week 3 - 11.5 Hours.

I hope this makes sense and you can help or is this the best i am going to be able to get?

Many thanks

Rich

[JohnTopley]

With NETWORKDAYS(.INTL) you do not know which day is a holiday so you cannot determine hours to be deducted as Monday-Thursday hours differ from Friday.

A 3 day week could be Mon-Wed, Wed-Fri, Tue-Thu etc (as simple examples).

I don't have 365 so hopefully one of the 365 gurus will reply as 365 has many advanced formula but, given the above, any formula is likely to be complex!

[JohnTopley]

Try

Option Explicit
Sub HPW()

Dim sDate As Date, Shift_Start As Double, lBreak As Double
Dim dT As Double, wkday As Integer, icol As Integer, n As Integer, lr As Long, wsn As Long
Dim res As Variant, bYear As Integer, r As Long
Dim wkhours As Double, ft As Double, Total_Workhours As Double
Dim Shift_End As Double
Dim wk_hrs(1 To 53) As Double, week_hours As Double

Application.ScreenUpdating = False

bYear = Year(Now)                                                                                ' "Base" year for holiday checking
lr = Cells(Rows.Count, "B").End(xlUp).Row

For r = 5 To lr                                                                                  ' Loop through input data

    sDate = Int(Cells(r, "E")): Shift_Start = Cells(r, "E") - sDate                              ' Initial Start date and Start time
    dT = Cells(r, "G")                                                                           ' Duration (Hours)
    wsn = Cells(r, "F")                                                                          ' Start Week
    
    n = 1: Total_Workhours = 0: week_hours = 0
    
    Do
        wkday = Weekday(sDate, vbMonday)                                                         ' Weekday (1=Monday, 7=Sunday)
                                                                  
        If wkday < 6 Then                                                                        ' Check if Monday to Friday
            If wkday <= 4 Then                                                                   ' Monday to Thursday
                Shift_End = Application.Min(Shift_Start + (dT / 24), Range("MT_End_time"))       ' Finish time (16:30)
                lBreak = 1 / 48                                                                  ' 30 minute lunch break
            Else
                 Shift_End = Range("F_End_time")                                                 ' Friday finish (12:00)
                 lBreak = 0                                                                      ' No lunch break
            End If                                                                               ' increment "day" index
            week_hours = week_hours + (Shift_End - Shift_Start - lBreak) * 24                    ' Assign hours for this day
            Total_Workhours = Total_Workhours + (Shift_End - Shift_Start - lBreak) * 24          ' Accumulate Total hours
        Else
            If wkday = 7 Then                                                                    ' End of week
                wk_hrs(n) = week_hours                                                           ' Weekly hours
                week_hours = 0
                n = n + 1                                                                        ' Increment week number
            End If
        End If
        
        Do                                                                                       ' Check for holidays
            sDate = sDate + 1
            icol = Year(sDate) - bYear + 1                                                       ' Holiday year column in range "Holidays"
            res = Application.Match(CLng(sDate), Range("holidays").Columns(icol), 0)             ' check if date is a holiday
        Loop While IsNumeric(res)                                                                ' Loop while match found
        
        Shift_Start = Range("Start_Time")                                                        ' Standard start time
        
    Loop While Round(Total_Workhours, 2) < dT                                                    ' Loop while work hours < duration hours

    If (Total_Workhours >= dT) Then wk_hrs(n) = week_hours - (Total_Workhours - dT)               ' Hours in last week

   With Sheets("Resource Requirements")
    .Cells(r, wsn + 11).Resize(1, n) = wk_hrs                                                     ' Output weekly hours
   End With
   
Next r
   
End Sub