How do I modify a macro to include formatting - need to add an extra row and bold certain text.

The attached file has a macro which inserts subtotals on each page.  There are two controls for adding subtotals and removing the subtotals - buttons at the top of the form.
I need assistance in modifying the macros so that when the subtotals are visible, the following formatting takes place.  An additional blank row appears above the subtotals, there are no boarders around the subtotal row and the subtotal row is in "bold."  When the remove subtotal button is selected, the extra row is deleted.  I have attached the document.  As a side note, Glen Ray assisted on 7/22/2014. ID#40210902.
H--Documents-Bad-Debt-Log-Master-2.xls
klitton7Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Glenn RayExcel VBA DeveloperCommented:
Since you needed to change from inserting one total row to two (a blank row & then total row), I modified the two subroutines that deal with inserting and removing total rows:

Insert:
Sub Insert_Subtotals()
    Dim r, i, x As Integer
    
    Range("A9").Select 'must start on row 9 to avoid false subtotal on top
    Do Until ActiveCell.Value = ""
        If (ActiveCell.Row - 6) Mod 28 = 0 Then
            'insert blank row
            ActiveCell.Offset(-1, 0).Select
            ActiveCell.EntireRow.Insert
            Range(ActiveCell, ActiveCell.Offset(0, 14)).Select
            For x = xlEdgeLeft To xlInsideHorizontal '7 to 12
                If x <> xlEdgeTop Then
                    With Selection.Borders(x)
                        .LineStyle = xlNone
                    End With
                End If
            Next x
            'insert page Total row
            ActiveCell.Offset(1, 0).Select
            ActiveCell.EntireRow.Insert
            ActiveCell.Value = "Total on this page"
            ActiveCell.Offset(0, 11).FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
            ActiveCell.Offset(0, 12).FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
            ActiveCell.Offset(0, 14).FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
            Range(ActiveCell, ActiveCell.Offset(0, 14)).Select
            Selection.Font.Bold = True
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
    r = ((ActiveCell.Row - 6) Mod 28)
    'insert blank row
    ActiveCell.EntireRow.Insert
    'insert page Total row
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = "Total on this page"
    ActiveCell.Offset(0, 11).FormulaR1C1 = "=SUM(R[-" & r & "]C:R[-2]C)"
    ActiveCell.Offset(0, 12).FormulaR1C1 = "=SUM(R[-" & r & "]C:R[-2]C)"
    ActiveCell.Offset(0, 14).FormulaR1C1 = "=SUM(R[-" & r & "]C:R[-2]C)"
    ActiveCell.RowHeight = 19.5
    
    i = ActiveCell.Row - 6
    ActiveCell.Offset(1, 0).Value = "GRAND TOTALS"
    ActiveCell.Offset(1, 11).FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)/2"
    ActiveCell.Offset(1, 12).FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)/2"
    ActiveCell.Offset(1, 14).FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)/2"
    ActiveCell.Offset(1, 0).RowHeight = 19.5
    
    Range(ActiveCell, ActiveCell.Offset(1, 14)).Select
    Selection.Font.Bold = True
   
    'copy formats for totals
    Range(ActiveCell.Offset(0, 11), ActiveCell.Offset(0, 14)).Copy
    Range(ActiveCell.Offset(0, 11), ActiveCell.Offset(1, 14)).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    
    Range("A6").Select
    
End Sub

Open in new window

The logic assumes that 28 rows will fit on a page, given the current row height of 19.50/row.

There was also an error in the last page Total row (before Grand Totals); it was looking too far up the column to do the sum.  There was a line of code preparing for that (r= (ActiveCell.Row - 6) Mod 28) but it wasn't used.  I updated that also.

Remove:
Sub Remove_Subtotals()
    Dim rng As Range
    Dim cl As Object
    Set rng = Range("A7:A" & Cells.SpecialCells(xlLastCell).Row)
    For Each cl In rng
        If cl.Text = "" Then 'remove blank row and total row after
            cl.Offset(1, 0).EntireRow.Delete
            cl.EntireRow.Delete
        End If
    Next cl
    Range("A7").End(xlDown).Select
    If ActiveCell.Value = "GRAND TOTALS" Then ActiveCell.EntireRow.Delete
    Range("A1").Select
End Sub

Open in new window

This is actually simplified from its previous version.

I added some addtional lines to test (copied and pasted existing data to the bottom) and it looks correct.  But, let me know if you have any issues.

Regards,
-Glenn
EE-H-Documents-BadDebtLogMaster-2b.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
klitton7Author Commented:
Glenn - yes, this is exactly what I was looking for and thanks for updating code to correct error in previous version.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.