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

klitton7
klitton7 used Ask the Experts™
on
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
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Excel VBA Developer
Top Expert 2014
Commented:
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

Author

Commented:
Glenn - yes, this is exactly what I was looking for and thanks for updating code to correct error in previous version.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start Today