Writing macro to add new calculated unit and include it in existing formulas

Question

I have this sheet formatted so that cell 34 is performing a calculation on cells C28-C33 and then adding the sums of those calculations. Cell C46 is then dividing cell 34 by row C25. The same pattern is used across the columns, and for each person in the list (Person A, B, C, and D). In the "Team Total Section", everyone's numbers for each task are added together (eg. cell C10,20,30,and 40 are added in cell C50), and then row 54 perform calculations on rows 48-53 and adds the output of the calculations. Finally, row 56 divides row 54 by row 55.&nbsp;&nbsp;I want to write a macro that can continuously add space for new team members with all the appropriate formulas set up to calculate the totals and percent utilization for the new team members and then factor those team members' numbers into the calculations for team totals. I've been able to write a pair of macros that can successfully do this once (eg. add one new team member and account for their totals in the Team Totals), but can't get it to automatically update to include more than one new team member in the "Team Totals" calculations. The formulas don't automatically expand to include the new cells that are added, so the calculation just reflects the totals of the old team members and the most recent one to be added. Help would be much appreciated.&nbsp;&nbsp;If it helps, here are the pair of macros that I've used to 1) add a single new team member and then 2)update the team totals:&nbsp;Sub Add_Team_Member()
'
' Add_Team_Member Macro
'

'
    Rows("7:16").Select
    Selection.Copy
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 33
    ActiveWindow.ScrollRow = 34
    Rows("47:47").Select
    Selection.Insert Shift:=xlDown
    Range("A47:H47").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Range("A54:B54").Select
    ActiveCell.FormulaR1C1 = "Total - "
    Range("C48:K53").Select
    Selection.ClearContents
    Range("C55:K55").Select
    Selection.ClearContents
    Range("A47:H47").Select
    ActiveCell.FormulaR1C1 = "New Team Member"
    Range("A54:B54").Select
    ActiveCell.FormulaR1C1 = "Total - New Team Member"
    Range("K54").Select
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
End Sub----Sub Update_Team_Totals()
'
' Update_Team_Totals Macro
'

'
    Application.Run "'OnCore Workload Aug 15_messingwith.xlsm'!Add_Team_Member"
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 43
    Range("K58").Select
    ActiveCell.FormulaR1C1 = "=R[-50]C+R[-40]C+R[-30]C+R[-20]C+R[-10]C"
    Range("K58").Select
    Selection.AutoFill Destination:=Range("K58:K63"), Type:=xlFillDefault
    Range("K58:K63").Select
    Range("K65").Select
    ActiveCell.FormulaR1C1 = "=R[-50]C+R[-40]C+R[-30]C+R[-20]C+R[-10]C"
    Range("N64").Select
End Sub

nikolinode · Accepted Answer

macreutter&nbsp;Attached is an attempt to adapt the existing code.&nbsp;Sub Add_Team_Member()
    Dim ws As Worksheet
    Dim lastRow As Long
    Set ws = ThisWorkbook.Sheets(1) ' Adjust the sheet name as needed
    
    ' Find the last row for existing team members
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' Copy the template row (adjust the row range to match your template structure)
    ws.Rows("7:16").Copy
    ' Insert the copied rows below the last team member (adjust as needed)
    ws.Rows(lastRow + 1).Insert Shift:=xlDown
    ws.Range("A" &amp; lastRow + 1 &amp; ":H" &amp; lastRow + 1).Value = "New Team Member"
    
    ' Clear the contents of specific cells for the new member's calculations
    ws.Range("C" &amp; lastRow + 2 &amp; ":K" &amp; lastRow + 8).ClearContents
    
    ' Update the team total formula
    Call Update_Team_Totals
End Sub

Sub Update_Team_Totals()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim startRow As Long
    Dim endRow As Long
    
    Set ws = ThisWorkbook.Sheets(1) ' Adjust the sheet name as needed
    
    ' Find the first row of team members (row 7 in this case)
    startRow = 7
    
    ' Find the last row of team members by checking for the last filled cell in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

' Determine the row range for summing team members' values (adjust column range if needed)
    endRow = lastRow - 1 ' Adjust depending on where calculations for individuals end
    
    ' Update the formula in the "Team Totals" row (assuming row 50 is for Team Totals)
    ws.Range("C50").Formula = "=SUM(C" &amp; startRow &amp; ":C" &amp; endRow &amp; ")"
    ws.Range("C50").AutoFill Destination:=ws.Range("C50:K50"), Type:=xlFillDefault
    
    ' Update calculations in row 54 (based on rows 48-53) and row 56 (divide by row 55)
    ws.Range("C54").Formula = "=(C48+C49+C50+C51+C52+C53)"
    ws.Range("C54").AutoFill Destination:=ws.Range("C54:K54"), Type:=xlFillDefault
    ws.Range("C56").Formula = "=C54/C55"
    ws.Range("C56").AutoFill Destination:=ws.Range("C56:K56"), Type:=xlFillDefault
    
    ' Inform the user
    MsgBox "New team member added and totals updated successfully!", vbInformation
End Sub&nbsp;Hope that it helps you&nbsp;😊&nbsp;

Forum Discussion

Writing macro to add new calculated unit and include it in existing formulas

2 Replies

Resources