Hours Distribution over Months using Dynamic Array and Macro

Brass Contributor

Hi Excel gurus,


I need your insight/opinion on how to improve the process of spreading hours over months using dynamic array functions and macro combo. My goal was to simplify the whole process while minimizing the use of a macro for easier maintenance... But still it seems a bit complex for a future template handler. Poor man, whoever that is...

I attached the excel sheets for better understanding. You can change 'Week# Test' cell C4 in Workload Forecast sheet and come back and forth between sheets to see how it works. Users won't see the manipulation table (B2:C4) in the final version and the macro will calculate today/this Friday itself later.


- The purpose of this template is to populate workload forecast hours over months. Users will key in hours in Activity List sheet only on a regular basis (weekly, biweekly, or monthly). Workload Forecast sheet will distributed the total hours from Activity List sheet automatically onward this Friday and leave the previous weeks hours as-is.

Ideally, users will input decreased hours each time as the project goes on, and their new distributed hours will be based on new hours input but somewhat close to the previous forecasted hours.


1. Activity List sheet: Users will populate Resources table (G6:K11). They can check if a resource has overwork week (>=60 hours) by looking at Max Subtotal FSV/person/week (G4:K4). Column B:F are references to populate resource hours.



2. Workload Forecast sheet: Names and Hours in Activity List sheet will be distributed automatically based on progress%/Milestone using custom DA functions and a macro. Several assumptions are below to understand what they are for.


  • Activating the sheet will initiate the macro that populates DA function values.
  • Original key dates (Ori. Date) are converted to closest next Friday each (Cnv. Date). For example, Feb 21 (Wed) is converted to Feb 23 (Fri). 
  • Each Milestones (MS1, 2, 3) represents how much the project is done (Prog%). For example, assume 40% of overall work is done on MS 1 date.
  • Each Milestones and Project End date will have number of weeks (Week#) and Progress% assigned to utilize (Prog%/MS). 
  • Week# Left and Prog%/MS Left shows how many weeks and progress% are left onward this Friday.
  • Total hours/Name from Activity List sheet are populated automatically using DAs and a macro.
    1. Leave the hours range before this Friday (converted today)
    2. Clear project hours range onward this Friday (previous forecasted hours)
    3. Populate DA functions - % and hours distributions (example is in rows 9:12)
    4. Copy-paste DA formula values for users to freely edit if needed.



Some major functions and macro code are below.


1. Week#

2. Prog%/MS

3. Week# left

4. Prog%/MS Left


Private Sub Worksheet_Activate()

Dim WS As Worksheet, Pct_Hrs_Rng, Pst_Fri_Rng, Hrs_Tbl_Rng As Range
    '1. find rows & columns needed
    '2. clear project hours range onward this Friday range
    '3. populate DA formulas
    '4. copy paste DA formula values
    Set WS = Sheets("Workload Forecast") 'WLF sheet
    Prj_Wks_Num = WorksheetFunction.Sum(WS.Range("$I$3#")) 'project weeks number
    Prj_Dur_Row = 15 'project duration row
    Pct_Hrs_Row = 18 'percent hours row
    Hrs_Bgn_Row = 19 'beginning of hours table row
    Hrs_End_Row = 30 'end of hours table row
    Hrs_Tot_Col = 2 'total hours column
    Hrs_Bgn_Col = 4 'beginning of hours table column
    Hrs_End_Col = 30 'end of hours table column
    Ths_Fri_Num = CDbl(WS.Cells(3, 3)) 'serial number of this Friday
    Pct_Wks_Lft = "$K$3#" '# weeks left for % hours distribution formula
    Pct_Prg_Lft = "$L$3#" 'progress% left for % hours distribution formula
    'find the column of this Friday
    For Prj_Dur_Col = Hrs_Bgn_Col To Hrs_End_Col 'FOR loop to find the column of this Friday
        If WS.Cells(Prj_Dur_Row, Prj_Dur_Col) = Ths_Fri_Num Then
            Ths_Fri_Col = Prj_Dur_Col 'column of this Friday
            Exit For
        End If
    Next Prj_Dur_Col
    'find the row of the last non-zero total hours row
    For Hrs_Tot_Row = Hrs_End_Row To Hrs_Bgn_Row Step -1 'FOR loop to find the last non-zero total hours row
        If WS.Cells(Hrs_Tot_Row, Hrs_Tot_Col) > 0 Then
            Hrs_LNZ_Row = Hrs_Tot_Row 'last non-zero total hours row
            Exit For
        End If
    Next Hrs_Tot_Row
    If (Hrs_Bgn_Col <= Ths_Fri_Col And Ths_Fri_Col <= Hrs_End_Col) _
    And (Ths_Fri_Col - Hrs_Bgn_Col < Prj_Wks_Num) Then  'if this Friday is within the project duration and the project is ongoing
        Set Pct_Hrs_Rng = WS.Range(WS.Cells(Pct_Hrs_Row, Hrs_Bgn_Col), WS.Cells(Pct_Hrs_Row, Hrs_End_Col + 0)) 'percent hours range
        Set Pst_Fri_Rng = WS.Range(WS.Cells(Hrs_Bgn_Row, Ths_Fri_Col), WS.Cells(Hrs_End_Row, Hrs_End_Col + 0)) 'onward this Friday range
        Set Hrs_Tbl_Rng = WS.Range(WS.Cells(Hrs_Bgn_Row, Hrs_Bgn_Col), WS.Cells(Hrs_End_Row, Hrs_End_Col + 0)) 'hrs table range
        If (Not Pst_Fri_Rng Is Nothing) Then 'if the range onward this Friady exists
            'populate % hours distribution
            Pct_Hrs_Rng.ClearContents 'clear contents of % hours distribution range
            WS.Cells(Pct_Hrs_Row, Ths_Fri_Col).Formula2 = "=DA_PERCENT_PLOT(" & Pct_Wks_Lft & "," & Pct_Prg_Lft & ")" 'populate % hours distribution formula
            'populate expected hours onward this Friday
            Pst_Fri_Rng.ClearContents 'clear contents of onward this Friday range
            WS.Cells(Hrs_Bgn_Row, Ths_Fri_Col).Formula2 = "=DA_HOURS_PLOT(R[0]C" & Hrs_Tot_Col & ",R" & Pct_Hrs_Row & "C" & Ths_Fri_Col & "#)" 'populate hours distribution formula
            WS.Range(WS.Cells(Hrs_Bgn_Row, Ths_Fri_Col), WS.Cells(Hrs_Bgn_Row, Ths_Fri_Col)).AutoFill _
            WS.Range(WS.Cells(Hrs_Bgn_Row, Ths_Fri_Col), WS.Cells(Hrs_LNZ_Row, Ths_Fri_Col)), xlFillSeries 'autofill hours distribution formula
            Pst_Fri_Rng.Copy 'copy onward this Friday range
            Pst_Fri_Rng.PasteSpecial xlPasteValues 'paste onward this Friday range
            Pct_Hrs_Rng.Copy 'copy %hours distribution range
            Pct_Hrs_Rng.PasteSpecial xlPasteValues 'paste %hours distribution range
            Application.CutCopyMode = False
            WS.Cells(Hrs_Bgn_Row, Ths_Fri_Col).Select
        End If
    End If
End Sub


Let me know if some features look like I overcomplicated them or whether they are necessary. Any suggestions or ideas for a better way will be much appreciated!

1 Reply

In case you see this security risk message, you can right-click the file, click 'Properties', and check 'Unblock' box to enable the macro.