Solved

Excel VBA - Merge / Borders / Bold

Posted on 2016-09-28
2
86 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

Enroll in July's Course of the Month

July's Course of the Month is now available! Enroll to learn HTML5 and prepare for certification. It's free for Premium Members, Team Accounts, and Qualified Experts.

Question has a verified solution.

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

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
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…

636 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