VBA Highlight sub total row within table

[CD2017]

Hello, I want to highlight the subtotal and total rows within a number of tables using VBA.

Each table has different numbers of rows and columns.

For example:
In table 1, the subtotal rows are: B23:J23, B35:J35, B39:J39, B44:J44, B51:J51.
The total row is B52:J52.
In table 2, the subtotal rows are B9:K9, B11:K11, B13:K13, B15:J16.
The total row is B16:K16.

The rows and columns will change for each table.

I have the below code which will highlight the entire row, but I only want to highlight the information within the table.

So for table 1, the whole table runs from cells B7:J52.

I want each of these ranges to be highlighted B23:J23, B35:J35, B39:J39, B44:J44, B51:J51. But I don't want to have to specify the range because it will change for each table.

Also the whole row may have blanks in it so I can't use xlright.

I'm looking for an efficient way to do it. I'm not sure if current region can be incorporate so that excel knows when the word subtotal is present, then highlight to the end of the row within the current region.

Any help would be appreciated!

Thanks.

Sub FormatTotalRows()
Dim rCell As Range
For Each rCell In Sheets("TrialBalancePS").Range("B7:J100")

If Right(rCell.Value, 5) = "Total" Then
Rows(rCell.Row).Interior.ColorIndex = 36
End If
If Right(rCell.Value, 11) = "Grand Total" Then
Rows(rCell.Row).Interior.ColorIndex = 44
End If

Next

End Sub

 

[JackDanIce]

Welcome to the board. Try:

Sub FormatTotalRows1()

    Dim x   As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("TrialBalancePS")
        On Error Resume Next: .AutoFilterMode = False: On Error GoTo 0
        
        x = .Cells(.Rows.Count, 10).End(xlUp).row
        
        With .Cells(7, 2).Resize(x - 6, 10)
            .AutoFilter field:=3, Criteria1:="Total"
            .SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 36
            
            .AutoFilter
            .AutoFilter field:=10, Criteria1:="Grand Total"
            .SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 44
        End With
    End With
    
    Application.ScreenUpdating = True

End Sub

 

[CD2017]

Thanks JackDanIce - I used your idea of using autofilter and applied the following code:

Sub Format_Totals()
ActiveSheet.AutoFilterMode = False

sheetlist = Array("CashSummaryPS", "ChangesInvCapCommitmentPS", _
"InvestmentRevalPS", "InvScheduleSummaryPS", "InvestorCapAcctITDPS", _
"InvestorCapAcctQTDPS", "TrialBalancePS")
For i = LBound(sheetlist) To UBound(sheetlist)
Worksheets(sheetlist(i)).Activate

With Range("B7").CurrentRegion

Range("B7").Autofilter _
field:=1, _
Criteria1:="*Total*", _
VisibleDropDown:=False

.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 36
Range("B7").Autofilter _
field:=1, _
Criteria1:="Grand Total", _
VisibleDropDown:=False

.SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 44
Range("B7").Autofilter
End With
Next

End Sub