Forum Discussion
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. I then use the following code to create a total of the hours each employee has worked:
Range("A2").ListObject.Unlist
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(6), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
This creates a new row under each employee and in the employee column enters the employee name and the word total ('Joe Bloggs Total') in bold and in the 6th column, the total hours, not in bold. So far so good. What I would like is this newly created subtotal row to be formatted in Bold and the colour of the row changed to a darker shade.
I have found several codes that I have tried but none give the desired effect. Some suggestions changed the colour of the entire row, but I need it to only change on the first 6 columns.
Thanks in advance.
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 SubThis 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.
Whilst it is quite likely that the new formula wouldn't meet the OPs exacting requirements it is interesting that the GROUPBY function combined with conditional formatting can at least get part of the way.
= GROUPBY( Table1[[#All],[Dept]:[Empl]], Table1[[#All],[Metric]], SUM, 3, 2 )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 SubHope it helps.
- 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.
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 SubThis 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.
