Solved

Make sub to format and total ranges

Posted on 2016-08-10
9
60 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 45

Expert Comment

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

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
 
LVL 28

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
Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

 
LVL 49

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 28

Expert Comment

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

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 23

Author Closing Comment

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

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

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

No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

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

18 Experts available now in Live!

Get 1:1 Help Now