VBA - Format Rows containing word 'Total'

[tlc53]

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!

 

[Joe4]

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.

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

 

[tlc53]

Thank you so, so, so, so, so, so much! Perfect!

 

[Peter_SSs]

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.

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

 

[Peter_SSs]

... does not require as much looping ...

Actually, no need to loop at all, we can do them all at once.

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

 

[tlc53]

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

 

[Peter_SSs]

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!

 

[tlc53]

Yes, I used the new code

 

[Peter_SSs]

Yes, I used the new code

Cheers.

 

[tlc53]

Cheers.

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!