VBA - Format Rows containing word 'Total'

tlc53

Active Member
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

MrExcel MVP, Junior Admin
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
 

Peter_SSs

MrExcel MVP, Moderator
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:

Peter_SSs

MrExcel MVP, Moderator
... 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
 

tlc53

Active Member
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

MrExcel MVP, Moderator
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

Active Member
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!
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Syntax errors
    Good Morning, Trying to compile a workbook, I keep getting a few errors. Here are the first two: [code=rich]Syntax Error: Function...
Top