Solved

Excel VBA - Merge / Borders / Bold

Posted on 2016-09-28
2
59 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

863 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now