vba to sum up each column for each employee on column (A)

[Medhat]

First I am trying at sum up each column for each employee on column (A). starting from column E till last column.
the issue I have that the code below refering to original data but ignoring the rest of columns at bottom as the code adds new row which contains total
you will notice (last 5 rows have been ignored as below code added 5 new total rows to original data)
Looking for responds.

Sub SumColumnsForEachName()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, startRow As Long
    Dim col As Long
    Dim sumRange As Range
    Dim isEmpty As Boolean
   
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your sheet name
   
    ' Find the last row with data in column A (or any column in use)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    ' Find the last column with data in row 1
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
   
    startRow = 2 ' Assuming the first row has headers
   
    For i = 2 To lastRow + 1 ' Loop through each row, including the last active row
        ' Check if the name changes or it's the last row
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Or i = lastRow + 1 Then
            If i > startRow Then
                ' Apply light gray background to existing data (excluding total row)
                ws.Range(ws.Cells(startRow, 1), ws.Cells(i - 1, lastCol)).Interior.Color = RGB(211, 211, 211)
               
                ' Insert a new row to place the totals
                ws.Rows(i).Insert Shift:=xlDown
               
                ' Sum each column for the range from startRow to i-1, only if not empty
                For col = 5 To lastCol
                    ' Define the range to sum
                    Set sumRange = ws.Range(ws.Cells(startRow, col), ws.Cells(i - 1, col))
                   
                    ' Check if the range is not completely empty
                    isEmpty = Application.WorksheetFunction.CountA(sumRange) = 0
                   
                    If Not isEmpty Then
                        ' Apply the sum formula if the column is not empty
                        ws.Cells(i, col).Formula = "=SUM(" & sumRange.Address & ")"
                    End If
                Next col
               
                ' Apply formatting to the totals row
                With ws.Cells(i, 2).Resize(1, lastCol - 1)
                    .Interior.Color = RGB(0, 0, 0) ' Black background
                    .Font.Color = RGB(255, 255, 255) ' White text
                    .Font.Bold = True
                End With
               
                ' Update startRow for the next employee group
                startRow = i + 1
            End If
        End If
    Next i
End Sub

 

[Alex Blakenburg]

Typically if you are inserting or deleting rows you want to work from the bottom up.
In your case inserting a row means that the lastRow is pushing down the sheet and is what is causing your loop to fall short of number of rows that are actually there.

Here is your code modified to work from the bottom up.

Sub SumColumnsForEachName()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, startRow As Long, lastRowSect As Long
    Dim col As Long
    Dim sumRange As Range
    Dim isEmpty As Boolean
    
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your sheet name
    
    ' Find the last row with data in column A (or any column in use)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    ' Find the last column with data in row 1
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    
    startRow = 2 ' Assuming the first row has headers
    lastRowSect = lastRow
    
    For i = lastRow To 2 Step -1        ' Loop through each row
        ' Check if the name changes or it's the last row
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Then
            ' Apply light gray background to existing data (excluding total row)
                ws.Range(ws.Cells(i, 1), ws.Cells(lastRowSect, lastCol)).Interior.Color = RGB(211, 211, 211)
                
                ' Insert a new row to place the totals
                ws.Rows(lastRowSect + 1).Insert Shift:=xlDown
                
                ' Sum each column for the range from startRow to i-1, only if not empty
                For col = 5 To lastCol
                    ' Define the range to sum
                    Set sumRange = ws.Range(ws.Cells(i, col), ws.Cells(lastRowSect, col))
                    
                    ' Check if the range is not completely empty
                    isEmpty = Application.WorksheetFunction.CountA(sumRange) = 0
                    
                    If Not isEmpty Then
                    ' Apply the sum formula if the column is not empty
                    ws.Cells(lastRowSect + 1, col).Formula = "=SUM(" & sumRange.Address & ")"
                    End If
                Next col
                
                ' Apply formatting to the totals row
                With ws.Cells(lastRowSect + 1, 2).Resize(1, lastCol - 1)
                    .Interior.Color = RGB(0, 0, 0) ' Black background
                    .Font.Color = RGB(255, 255, 255) ' White text
                    .Font.Bold = True
                End With
                
                ' Update startRow for the next employee group
                lastRowSect = i - 1
        End If
    Next i
End Sub

 

[kvsrinivasamurthy]

Try. Change this line

  For i = 2 To lastRow + 1 ' Loop through each row, including the last active row

as
i = 2

Do while ws.Cells(i, 1).Value <>""   ' Loop through each row, including the last active row

This line

  Next i

as

Loop

 

[Alex Blakenburg]

@kvsrinivasamurthy - Did you try your changes ?
Since you are not using the for/next loop the code needs to advance and keep track of "i".

Here is my test data if you want to try your code:

20240822 VBA Insert Subtotal Rows Medhat.xlsm
	A	B	C	D	E	F	G
1	Name	Col2	Col3	Col4	Amt 1	Amt 2	Amt 3
2	Apple				20	120	1020
3	Apple				30	130	1030
4	Apple				40	140	1040
5	Apple				50	150	1050
6	Orange				60	160	1060
7	Orange				70	170	1070
8	Orange				80	180	1080
9	Orange				90	190	1090
10	Pear				100	200	1100
11	Pear				110	210	1110
12	Pear				120	220	1120
13	Kiwi				130	230	1130
14	Melon				140	240	1140
15	Melon				150	250	1150
16	Melon				160	260	1160
17
Sheet1

Cell Formulas
Range	Formula
F2:F16	F2	=E2+100
G2:G16	G2	=1000+E2

 

[Medhat]

Try. Change this line

  For i = 2 To lastRow + 1 ' Loop through each row, including the last active row

as
i = 2

Do while ws.Cells(i, 1).Value <>""   ' Loop through each row, including the last active row

This line

  Next i

as

Loop

Thanks very much Alex!!!
Works as I wish - you are really expertise in VBA coding, Much appreciated.

 

[Alex Blakenburg]

You're welcome. Glad we could help.

 

[kvsrinivasamurthy]

@ Alex Blakenburg
I have corrected the code.

Sub SumColumnsForEachName()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, startRow As Long
    Dim col As Long
    Dim sumRange As Range
    Dim isEmpty As Boolean
   
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change to your sheet name
   
    ' Find the last row with data in column A (or any column in use)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    ' Find the last column with data in row 1
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
   
    startRow = 2 ' Assuming the first row has headers
   i = 3
    'For i = 2 To lastRow + 1 ' Loop through each row, including the last active row
    Do While ws.Cells(i, 1) <> ""
        
        ' Check if the name changes or it's the last row
        If ws.Cells(i, 1).Value <> ws.Cells(i - 1, 1).Value Or ws.Cells(i + 1, 1) = "" Then 'Or i = lastRow + 1
            If ws.Cells(i + 1, 1) = "" Then i = i + 1
            If i > startRow Then
                ' Apply light gray background to existing data (excluding total row)
                ws.Range(ws.Cells(startRow, 1), ws.Cells(i - 1, lastCol)).Interior.Color = RGB(211, 211, 211)
               
                ' Insert a new row to place the totals
                ws.Rows(i).Insert Shift:=xlDown
               
                ' Sum each column for the range from startRow to i-1, only if not empty
                For col = 5 To lastCol
                    ' Define the range to sum
                    Set sumRange = ws.Range(ws.Cells(startRow, col), ws.Cells(i - 1, col))
                   
                    ' Check if the range is not completely empty
                    isEmpty = Application.WorksheetFunction.CountA(sumRange) = 0
                   
                    If Not isEmpty Then
                        ' Apply the sum formula if the column is not empty
                        ws.Cells(i, col).Formula = "=SUM(" & sumRange.Address & ")"
                    End If
                Next col
               
                ' Apply formatting to the totals row
                With ws.Cells(i, 2).Resize(1, lastCol - 1)
                    .Interior.Color = RGB(0, 0, 0) ' Black background
                    .Font.Color = RGB(255, 255, 255) ' White text
                    .Font.Bold = True
                End With
               
                ' Update startRow for the next employee group
                startRow = i + 1
            End If
        End If
     i = i + 1
     Loop
    'Next i
End Sub