?
Solved

Make sub to format and total ranges

Posted on 2016-08-10
9
Medium Priority
?
85 Views
Last Modified: 2016-08-11
Before.xlsx shows the current state.
After.xlsx shows what I want.

In Before, for User 1, I recorded the macro to make it look like After.

Is there a way to make this more 'generic' so that it runs for the other Users, regardless of how many?

Sub Title_And_Total_Group()
    Range("A4").Select
    Selection.Copy
    Range("C3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Calibri"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("F8").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
    Range("F8").Select
    Selection.Copy
    Range("F8:M8").Select
    ActiveSheet.Paste
    Selection.Font.Bold = True
    Selection.End(xlToLeft).Select
    Range("A11").Select
End Sub

Open in new window

Before.xlsx
After.xlsx
0
Comment
Question by:NVIT
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 46

Expert Comment

by:aikimark
ID: 41751357
.xlsx can not contain VBA code.  You will need to save as .xlsm format
0
 
LVL 26

Author Comment

by:NVIT
ID: 41751362
I know that. Can you help w/ a macro solution?
0
 
LVL 46

Expert Comment

by:aikimark
ID: 41751366
Ah.  I'll look at it tomorrow AM.
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
LVL 34

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 1000 total points
ID: 41751499
Please try this.....
Sub ApplyFormatAndFormuals()
Dim rng As Range
Application.ScreenUpdating = False
For Each rng In Range("A:A").SpecialCells(xlCellTypeConstants, 2).Areas
    If rng.Cells(1).Row <> 1 Then
        rng.Cells(1).Copy rng.Cells(1).Offset(-1, 2)
        With rng.Cells(1).Offset(-1, 2).Font
            .Bold = True
            .Size = 14
            .Name = "Calibri"
        End With
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Font.Bold = True
    End If
Next rng
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 54

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 1000 total points
ID: 41751548
HI,

Since the number of lines is variable, then try
Sub ApplyFormatAndFormuals()
Dim rng As Range
Application.ScreenUpdating = False
For Each rng In Range("A:A").SpecialCells(xlCellTypeConstants, 2).Areas
    If rng.Cells(1).Row <> 1 Then
        rng.Cells(1).Copy rng.Cells(1).Offset(-1, 2)
        With rng.Cells(1).Offset(-1, 2).Font
            .Bold = True
            .Size = 14
            .Name = "Calibri"
        End With
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).FormulaR1C1 = "=SUM(R[-" & rng.Rows.Count & "]C:R[-1]C)"
        rng.Cells(rng.Rows.Count + 1).Offset(0, 5).Resize(, 8).Font.Bold = True
    End If
Next rng
Application.ScreenUpdating = True
End Sub

Open in new window

Regards
0
 
LVL 34

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41751561
Good point Rgonzo. I missed that.
Thanks for tweaking the code accordingly. :)
0
 
LVL 35

Expert Comment

by:Rob Henson
ID: 41751688
You can get a similar result without VBA and using the Subtotal Wizard or with a slight change to the data format, you could use a Pivot Table.

Thanks
Rob H
Before.xlsx
0
 
LVL 26

Author Closing Comment

by:NVIT
ID: 41753236
Thank you, Neeraj and Rgonzo!
0
 
LVL 26

Author Comment

by:NVIT
ID: 41753241
Is it easy enough for you to revise your code and add bottom borders on the last 2 rows as shown?
Add bottom borders under 2 total rows
Or, should I open another question?
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Question has a verified solution.

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

This is an article on how to answer questions, earn points and become an expert.
I tried to use the SharePoint app to Import a Spreadsheet and import an Excel sheet into a Team site made in SharePoint 2016. But that just resulted in getting an error message 'Unknown Error'...
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…
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

594 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