Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Excel VBA - Merge / Borders / Bold

Posted on 2016-09-28
2
Medium Priority
?
95 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 2000 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

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

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

Outlook for dependable use in a very small business   This article is about using the Outlook application (part of Microsoft Office) in a very small business, or for homeowners where dependability and reliability are critical requirements. This …
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…

772 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