Bolding problem on Subtotals

[CLR]

Hi All...........

I have this macro, put together by kind people in this group..........

Sub AddRowSubTotalsBoth()
'Adds blank rows to the Sub-totaled sheet for easier reading
'Also changes font on the first 30 columns from the left to BOLD
Dim lastrow As Long
Dim r As Long

lastrow = Range("A" & Rows.Count).End(xlUp).Row
For r = lastrow To 2 Step -1
If InStr(1, Cells(r, 3).Value, "Total") > 0 Or _
InStr(1, Cells(r, 8).Value, "Total") > 0 Then
Range(Cells(r, 1), Cells(r, 30)).Font.Bold = True '30 is number
'of columns from "A" that the macro is supposed to BOLD
ActiveSheet.Rows(r + 1).EntireRow.Insert

End If
Next
End Sub

I use it to add blank rows to separate and make bold the Subtotals of
reports (obtained using the Data > Subtotals feature) to make the subtotal
titles and values easier to read. There are two different reports I use
this macro with. One has the word total in a string in column "C" and the
other has it in column "H". It all works fine except for the bottommost
subtotal and the Grand Total values in both reports.......these two values,
both in Column "X" are left normal font, even tho their titles in column "C"
or "H" respectively are bolded. The subtotals of the upper groups, also in
column "X" DO get bolded........just these two don't.

Also, there is no insertion of a blank row between the bottommost Subtotal
and the Grand total..........but this is not as serious as the two values
not being bold.


Any help to insure these last two get changed to Bold Font ( and maybe the
last blank row insertion), would be appreciated.

TIA
Vaya con Dios,
Chuck, CABGx3

 

[Tom Ogilvy]

You use column A to find the bottom of your data, but there are no entries
in A for the two problematic line. Solution would be to change A to X in
lastrow = Range("A" & Rows.Count).End(xlUp).Row

would be

lastrow = Range("X" & Rows.Count).End(xlUp).Row

This should solve you insert row problem as well

Otherwise, leave the macro as written.


Sub AddRowSubTotalsBoth()
'Adds blank rows to the Sub-totaled sheet for easier reading
'Also changes font on the first 30 columns from the left to BOLD
Dim lastrow As Long
Dim r As Long

lastrow = Range("A" & Rows.Count).End(xlUp).Row
For r = lastrow To 2 Step -1
If InStr(1, Cells(r, 3).Value, "Total") > 0 Or _
InStr(1, Cells(r, 8).Value, "Total") > 0 Then
Range(Cells(r, 1), Cells(r, 30)).Font.Bold = True '30 is number
'of columns from "A" that the macro is supposed to BOLD
ActiveSheet.Rows(r + 1).EntireRow.Insert

End If
Next
End Sub

 

[CLR]

You are AMAZING Tom!...........your fix worked perfectly for both my
problems.

Thank you very kindly.

Vaya con Dios,
Chuck, CABGx3