Excel VBA - Merge / Borders / Bold

Hi all,
New to the forum, and liking what I see. Please see the attached, with VBA.

Take a look at the formatting I did on the first page, I'm trying to replicate that.

(The VBA code is not set-up to be reversed and will be used on a copy of the dataset.)  I've never before used VBA to do merge, and I'm a little confused on how to do it in this situation, along with the border, and bolding of the totals...

Thanks all for your help!
EE-PERFORMANCE_STATEMENT-06--3-.xls
Grant SteadAsked:
Who is Participating?
 
byundtConnect With a Mentor Commented:
It would be very helpful if you posted a worksheet containing the starting point. You should also put your code in a regular module sheet rather than in the code pane for one of the worksheets. This latter place is really supposed to be used for worksheet event subs and ActiveX click event subs.

I took a guess at your starting point, and rewrote your macro to avoid selecting cells.
Sub Insert_Subtotals()
Dim i As Long, ii As Long, iii As Long, n As Long, nn As Long
Dim bLast As Boolean
Dim rg As Range
Application.ScreenUpdating = False
    
    With ActiveSheet
        n = .Cells(.Rows.Count, "C").End(xlUp).Row
        nn = (n - 3) / 34
        nn = nn * 34 + 4
        Set rg = .UsedRange.EntireRow
        ApplyBorders Intersect(.Range("A4:J65536"), .UsedRange)
    End With
    
    bLast = True
    For ii = nn To 34 Step -34
        If bLast = False Then
            i = ii
            rg.Rows(i).Resize(4).EntireRow.Insert
            RemoveBorders rg.Rows(i).Resize(4)
        Else
            i = n
            bLast = False
            
                'Total Totals Grandest
            iii = i + 5
            'ActiveCell.Row - 3
            rg.Cells(iii, 3).Value = "CONTRACT GRAND TOTALS"
            rg.Cells(iii, 3).HorizontalAlignment = xlRight
            rg.Cells(iii, 4).FormulaR1C1 = "=SUM(R4C:R[-1]C)/3"
            rg.Cells(iii, 6).FormulaR1C1 = "=SUM(R4C:R[-1]C)/3"
            rg.Cells(iii, 8).FormulaR1C1 = "=SUM(R4C:R[-1]C)/3"
            rg.Cells(iii, 9).FormulaR1C1 = "=SUM(R4C:R[-1]C)/3"
            rg.Cells(iii, 10).FormulaR1C1 = "=SUM(R4C:R[-1]C)/3"
            rg.Rows(iii).EntireRow.RowHeight = 10.75
        End If
        
            'Totals for this page
        rg.Cells(i, 3).Value = "SUBTOTALS - for this page"
        rg.Cells(i, 3).HorizontalAlignment = xlRight
        rg.Cells(i, 4).FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
        rg.Cells(i, 5).FormulaR1C1 = "=RC[1]/RC[-1]"
        rg.Cells(i, 6).FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
        rg.Cells(i, 8).FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
        rg.Cells(i, 9).FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
        rg.Cells(i, 10).FormulaR1C1 = "=SUM(R[-34]C:R[-1]C)"
        rg.Cells(i, 4).Resize(1, 7).Font.Bold = True
        ApplyBorders rg.Cells(i, 4).Resize(1, 7)
        
            'Undistributed Charges
        rg.Cells(i + 1, 7).Value = "Undistributed Charges/Material"
        rg.Cells(i + 1, 7).HorizontalAlignment = xlRight
        ApplyBorders rg.Cells(i + 1, 8).Resize(1, 3)
            
            'Other Charges
        rg.Cells(i + 2, 7).Value = "Other"
        rg.Cells(i + 2, 7).HorizontalAlignment = xlRight
        ApplyBorders rg.Cells(i + 21, 8).Resize(1, 3)
            
            'GRAND TOTALS for this page
        rg.Cells(i + 3, 7).Value = "GRAND SUBTOTALS - for this page"
        rg.Cells(i + 3, 7).HorizontalAlignment = xlRight
        rg.Cells(i + 3, 8).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
        rg.Cells(i + 3, 9).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
        rg.Cells(i + 3, 10).FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
        rg.Cells(i + 3, 8).Resize(1, 3).Font.Bold = True
        ApplyBorders rg.Cells(i + 3, 8).Resize(1, 3)
    Next
    
    MsgBox "Subtotals Inserted"
End Sub

Sub ApplyBorders(rg As Range)
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub

Sub RemoveBorders(rg As Range)
    With rg.Borders
        .LineStyle = xlNone
     End With
End Sub

Open in new window

EE-PERFORMANCE_STATEMENT_Q28973132.xlsm
0
 
Grant SteadAuthor Commented:
AWESOME - not only took care of the problem at hand, but modified some existing code as well!
0
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.

All Courses

From novice to tech pro — start learning today.