Solved

Excel VBA - Merge / Borders / Bold

Posted on 2016-09-28
2
65 Views
Last Modified: 2016-09-29
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
0
Comment
Question by:Grant Stead
2 Comments
 
LVL 81

Accepted Solution

by:
byundt earned 500 total points
ID: 41821172
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
 

Author Closing Comment

by:Grant Stead
ID: 41821591
AWESOME - not only took care of the problem at hand, but modified some existing code as well!
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question