[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

How do I modify a macro to include formatting - need to add an extra row and bold certain text.

Posted on 2014-08-27
2
Medium Priority
?
157 Views
Last Modified: 2014-08-28
The attached file has a macro which inserts subtotals on each page.  There are two controls for adding subtotals and removing the subtotals - buttons at the top of the form.
I need assistance in modifying the macros so that when the subtotals are visible, the following formatting takes place.  An additional blank row appears above the subtotals, there are no boarders around the subtotal row and the subtotal row is in "bold."  When the remove subtotal button is selected, the extra row is deleted.  I have attached the document.  As a side note, Glen Ray assisted on 7/22/2014. ID#40210902.
H--Documents-Bad-Debt-Log-Master-2.xls
0
Comment
Question by:klitton7
2 Comments
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 2000 total points
ID: 40289607
Since you needed to change from inserting one total row to two (a blank row & then total row), I modified the two subroutines that deal with inserting and removing total rows:

Insert:
Sub Insert_Subtotals()
    Dim r, i, x As Integer
    
    Range("A9").Select 'must start on row 9 to avoid false subtotal on top
    Do Until ActiveCell.Value = ""
        If (ActiveCell.Row - 6) Mod 28 = 0 Then
            'insert blank row
            ActiveCell.Offset(-1, 0).Select
            ActiveCell.EntireRow.Insert
            Range(ActiveCell, ActiveCell.Offset(0, 14)).Select
            For x = xlEdgeLeft To xlInsideHorizontal '7 to 12
                If x <> xlEdgeTop Then
                    With Selection.Borders(x)
                        .LineStyle = xlNone
                    End With
                End If
            Next x
            'insert page Total row
            ActiveCell.Offset(1, 0).Select
            ActiveCell.EntireRow.Insert
            ActiveCell.Value = "Total on this page"
            ActiveCell.Offset(0, 11).FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
            ActiveCell.Offset(0, 12).FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
            ActiveCell.Offset(0, 14).FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
            Range(ActiveCell, ActiveCell.Offset(0, 14)).Select
            Selection.Font.Bold = True
        End If
        ActiveCell.Offset(1, 0).Select
    Loop
    
    r = ((ActiveCell.Row - 6) Mod 28)
    'insert blank row
    ActiveCell.EntireRow.Insert
    'insert page Total row
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Value = "Total on this page"
    ActiveCell.Offset(0, 11).FormulaR1C1 = "=SUM(R[-" & r & "]C:R[-2]C)"
    ActiveCell.Offset(0, 12).FormulaR1C1 = "=SUM(R[-" & r & "]C:R[-2]C)"
    ActiveCell.Offset(0, 14).FormulaR1C1 = "=SUM(R[-" & r & "]C:R[-2]C)"
    ActiveCell.RowHeight = 19.5
    
    i = ActiveCell.Row - 6
    ActiveCell.Offset(1, 0).Value = "GRAND TOTALS"
    ActiveCell.Offset(1, 11).FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)/2"
    ActiveCell.Offset(1, 12).FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)/2"
    ActiveCell.Offset(1, 14).FormulaR1C1 = "=SUM(R[-" & i & "]C:R[-1]C)/2"
    ActiveCell.Offset(1, 0).RowHeight = 19.5
    
    Range(ActiveCell, ActiveCell.Offset(1, 14)).Select
    Selection.Font.Bold = True
   
    'copy formats for totals
    Range(ActiveCell.Offset(0, 11), ActiveCell.Offset(0, 14)).Copy
    Range(ActiveCell.Offset(0, 11), ActiveCell.Offset(1, 14)).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    
    Range("A6").Select
    
End Sub

Open in new window

The logic assumes that 28 rows will fit on a page, given the current row height of 19.50/row.

There was also an error in the last page Total row (before Grand Totals); it was looking too far up the column to do the sum.  There was a line of code preparing for that (r= (ActiveCell.Row - 6) Mod 28) but it wasn't used.  I updated that also.

Remove:
Sub Remove_Subtotals()
    Dim rng As Range
    Dim cl As Object
    Set rng = Range("A7:A" & Cells.SpecialCells(xlLastCell).Row)
    For Each cl In rng
        If cl.Text = "" Then 'remove blank row and total row after
            cl.Offset(1, 0).EntireRow.Delete
            cl.EntireRow.Delete
        End If
    Next cl
    Range("A7").End(xlDown).Select
    If ActiveCell.Value = "GRAND TOTALS" Then ActiveCell.EntireRow.Delete
    Range("A1").Select
End Sub

Open in new window

This is actually simplified from its previous version.

I added some addtional lines to test (copied and pasted existing data to the bottom) and it looks correct.  But, let me know if you have any issues.

Regards,
-Glenn
EE-H-Documents-BadDebtLogMaster-2b.xls
0
 

Author Comment

by:klitton7
ID: 40290382
Glenn - yes, this is exactly what I was looking for and thanks for updating code to correct error in previous version.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
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…

872 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