Solved

Make sub to format and total ranges

Posted on 2016-08-10
9
69 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
[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
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 45

Expert Comment

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

Author Comment

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

Expert Comment

by:aikimark
ID: 41751366
Ah.  I'll look at it tomorrow AM.
0
Simplifying Server Workload Migrations

This use case outlines the migration challenges that organizations face and how the Acronis AnyData Engine supports physical-to-physical (P2P), physical-to-virtual (P2V), virtual to physical (V2P), and cross-virtual (V2V) migration scenarios to address these challenges.

 
LVL 31

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 250 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 51

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 250 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 31

Expert Comment

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

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 24

Author Closing Comment

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

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

SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Office applications crashing 7 35
Pull data from a another spreadsheet tab 3 31
3,000 rows of comma separated values 14 31
Aggregate data in an EXCEL file. 12 46
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!
I was prompted to write this article after the recent World-Wide Ransomware outbreak. For years now, System Administrators around the world have used the excuse of "Waiting a Bit" before applying Security Patch Updates. This type of reasoning to me …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
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…

752 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