Forum Discussion

Copper Contributor

Mar 10, 2024

Solved

How to format a subtotal row

Hi. I have a timesheet spreadsheet that is filled at random times during a week by my employees. At the end of the week, I run a macro on it to sort the rows in to groups of each individual employee....

Macros and VBA

NikolinoDE

Mar 10, 2024

BillZab

If the position of the subtotal rows varies each week and there could be different numbers of rows between each subtotal row, we can adjust the code to dynamically identify and format the subtotal row based on certain criteria. One way to do this is to check if a row contains the word "Total" in the employee name column. Here's how you can modify the code to achieve this:

Sub ApplySubtotalFormatting()
    ' Remove existing subtotal
    Range("A2").ListObject.Unlist
    
    ' Apply subtotal
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(6), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    ' Get the last row of data
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Loop through each row
    Dim i As Long
    For i = 3 To lastRow
        ' Check if the row contains "Total" in the employee name column
        If InStr(1, Cells(i, 1).Value, "Total", vbTextCompare) > 0 Then
            ' Format the subtotal row
            Range("A" & i & ":F" & i).Font.Bold = True
            Range("A" & i & ":F" & i).Interior.Color = RGB(192, 192, 192) ' Change to your desired color
        End If
    Next i
End Sub

This code will loop through each row of the data and check if the employee name column contains the word "Total". If it does, it will format that row as a subtotal row. Adjust the range and color code to fit your specific requirements. This approach should work regardless of the position of the subtotal rows or the number of rows between them.

NikolinoDE

Platinum Contributor

Mar 10, 2024

BillZab

Here's an approach as a solution, maybe it will help you further with your plans.

Vba code is untested, please backup your file before testing the code.

Sub ApplySubtotalFormatting()
    ' Remove existing subtotal
    Range("A2").ListObject.Unlist
    
    ' Apply subtotal
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(6), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    ' Get the last row of data
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Loop through each subtotal row
    Dim i As Long
    For i = 3 To lastRow Step 2 ' Assumes subtotal rows are every other row starting from row 3
        ' Format employee name and total hours columns
        Range("A" & i & ":F" & i).Font.Bold = True
        Range("A" & i & ":F" & i).Interior.Color = RGB(192, 192, 192) ' Change to your desired color
    Next i
End Sub

Hope it helps.

BillZab
Copper Contributor
Mar 10, 2024
Hi. Many thanks for your reply. I have implemented your code, but what happens is it just formats each alternate row. The subtotal row will be in a different position each week with different numbers of rows between each Subtotal row. I only need the subtotal row formatted. Your code says to assume subtotal rows are every other row. Subtotal rows could be (for example as this weeks sheet) row 10, row 19, row 31, row 44 and row row53. This could be different next week as each employee may have different amount of entries. Many thanks.
- NikolinoDE
  Platinum Contributor
  Mar 10, 2024
  BillZab
  If the position of the subtotal rows varies each week and there could be different numbers of rows between each subtotal row, we can adjust the code to dynamically identify and format the subtotal row based on certain criteria. One way to do this is to check if a row contains the word "Total" in the employee name column. Here's how you can modify the code to achieve this:
  Sub ApplySubtotalFormatting() ' Remove existing subtotal Range("A2").ListObject.Unlist ' Apply subtotal Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(6), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True ' Get the last row of data Dim lastRow As Long lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' Loop through each row Dim i As Long For i = 3 To lastRow ' Check if the row contains "Total" in the employee name column If InStr(1, Cells(i, 1).Value, "Total", vbTextCompare) > 0 Then ' Format the subtotal row Range("A" & i & ":F" & i).Font.Bold = True Range("A" & i & ":F" & i).Interior.Color = RGB(192, 192, 192) ' Change to your desired color End If Next i End Sub
  This code will loop through each row of the data and check if the employee name column contains the word "Total". If it does, it will format that row as a subtotal row. Adjust the range and color code to fit your specific requirements. This approach should work regardless of the position of the subtotal rows or the number of rows between them.
  - BillZab
    Copper Contributor
    Mar 16, 2024
    NikolinoDE many thanks. This worked perfectly for me.