VBA - Format Rows containing word 'Total'

tlc53

Active Member
Joined
Jul 26, 2018
Messages
399
Hi,
I'm using the function Subtotal on my Defined Name range. I would like to format the totals that come through, so that they stand out from the rest of the data. I would like to do this without necessary referring to exact rows/cells, so that the format will work even if the data changes.
My named range is 'CordisTest1'
My data headings are always on row 52
K52 is for heading 'Account' and is what the Subtotal function is based on.
I would like it if column K in my named range 'CordisTest1' contains the word 'Total', cells A:J to the left of it will be formatted to have a plain line border around only, fill 15% grey and be bold font.
Not sure if this is even possible. If not, please could you let me know. Thank you!
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Try this:

If the formatting piece isn't quite perfect (i.e. wrong color), you can turn on the Macro Recorder and record yourself setting the color you want. Then you can copy over the correct color number into the code.
Code:
Sub MyFormat()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column K
    lr = Cells(Rows.Count, "K").End(xlUp).Row
    
'   Loop through all rows starting on row 53
    If lr < 53 Then Exit Sub
    For r = 53 To lr
'       Check for existence of the word Total in the cell
        If Right(Cells(r, "K"), 5) = "Total" Then
'           Apply your formatting
            With Range(Cells(r, "A"), Cells(r, "J"))
'               Bolding
                .Font.FontStyle = "Bold"
'               Color
                .Interior.ThemeColor = xlThemeColorDark1
                .Interior.TintAndShade = -0.249946592608417
            End With
'           Borders
            With Range(Cells(r, "A"), Cells(r, "J")).Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Range(Cells(r, "A"), Cells(r, "J")).Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Range(Cells(r, "A"), Cells(r, "J")).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Range(Cells(r, "A"), Cells(r, "J")).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If
    Next r

    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
I see that you have a solution that you are happy with but in case you are interested, here is another option that you might like to try that does not require as much looping or as much manipulation of border parts.

Code:
Sub FormatTotals()
  Dim rw As Range
  
  Application.ScreenUpdating = False
  With Range("A52", Range("K" & Rows.Count).End(xlUp))
    .AutoFilter Field:=11, Criteria1:="*Total"
    For Each rw In .Offset(1).Resize(.Rows.Count - 1, 10).SpecialCells(xlVisible).Rows
      With rw
        .Font.Bold = True
        .Interior.Color = 12566463
        .BorderAround xlContinuous
      End With
    Next rw
    .Parent.AutoFilterMode = False
  End With
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
... does not require as much looping ...
Actually, no need to loop at all, we can do them all at once.

Code:
Sub FormatTotals_v2()
  Dim rw As Range
  
  Application.ScreenUpdating = False
  With Range("A52", Range("K" & Rows.Count).End(xlUp))
    .AutoFilter Field:=11, Criteria1:="*Total"
    With .Offset(1).Resize(.Rows.Count - 1, 10).SpecialCells(xlVisible).Rows
      .Font.Bold = True
      .Interior.Color = 12566463
      .BorderAround xlContinuous
      .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    .Parent.AutoFilterMode = False
  End With
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
I see that you have a solution that you are happy with but in case you are interested, here is another option that you might like to try that does not require as much looping or as much manipulation of border parts.

Thank you! You make it look so simple and short. Works a charm :)
 
Upvote 0
Thank you! You make it look so simple and short. Works a charm :)
You have quoted my text from post 4 but hopefully you are referring to the code from post 5.
In any case, you are very welcome! :)
 
Upvote 0

Hi Peter. Sorry for not starting a new post but continuing from here means I have to explain myself less.

There is an extra element I would like to add, if it is possible.

Currently my sub totals are highlighted grey and are in bold so that they stand out. It looks great, very clear. The only thing that would be nice, is to have the description name also showing next to the total.

This would need to work on the following basis;

In the summary section,
K21-K35 contains the account numbers
A21-A35 contains the description relating to the account number (please note, these cells are merged, so A21 is actually merged cells A21,B21&C21)

The account numbers in the narrative section start from K53 (K52 is a header). So if column K = an account number from K21-K35 plus the word Total (eg. 36352 Total) then return the description from A21-A35 into column C on the row that contains account number + Total.

Also if column K (starting from K53) = Grand Total, transfer this description to column C on the same row.

I hope that's not completely confusing. Appreciate you looking at this.

Thank you!
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top