Solved

VBA to add percentage

Posted on 2013-11-06
9
982 Views
Last Modified: 2013-11-06
Hello,
Can you please help,
I'm using below code to add Summary to columns.
Can you please help me to add the percentage underneath the summary.
Number of rows and columns are different.

Please see sample attached.

Font Color RED
Percentage sign
formula = Column Summary / Subtotal Amount

 'Add Summary To Columns
    Sheets("Yearly_Totals").Select
    Dim r As Range, j As Long, k As Long
    j = Range("A1").End(xlToRight).Column
    For k = 5 To j
        Set r = Range(Cells(1, k), Cells(1, k).End(xlDown))
        r.End(xlDown).Offset(2, 0) = WorksheetFunction.Sum(r)
    Next k
        With Range("A1").CurrentRegion
        With .Offset(.Rows.Count).Resize(2)
            .Interior.Color = vbYellow
        End With
    End With

thanks,
sample.xlsx
0
Comment
Question by:W.E.B
[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
  • 3
  • 2
9 Comments
 
LVL 12

Expert Comment

by:Harry Lee
ID: 39629040
Wass_QA,

I have completely rewrote your macro. Please use the following macro.

Sub AddColumnSummary()

Dim WS As Worksheet, Clmns As Long, Rws As Long, Clmn As Long, Rng As Range

Set WS = Sheets("Yearly_Totals")
Clmns = WS.Cells(1, Columns.Count).End(xlToLeft).Column
Rws = WS.Cells(Rows.Count, 1).End(xlUp).Row

    For Clmn = 5 To Clmns
        Set Rng = WS.Range(Cells(2, Clmn), Cells(Rws, Clmn))
        WS.Cells(Rws + 2, Clmn).Formula = "=Sum(" & Rng.Address & ")"
    Next
        
    For Clmn = 5 To Clmns - 2
        WS.Cells(Rws + 3, Clmn).Formula = "=Average(" & Cells(Rws + 2, Clmn).Address & "/" & Cells(Rws + 2, Clmns - 1).Address & ")"
    Next

With Range(Cells(Rws + 1, 1), Cells(Rws + 2, Clmns))
    .Interior.Color = vbYellow
    .Font.Bold = True
End With
With Range(Cells(Rws + 3, 5), Cells(Rws + 3, Clmns - 2))
    .Font.Color = vbRed
    .Style = "Percent"
    .NumberFormat = "0.00%"
End With

With Cells(Rws + 2, Clmns - 1).Font
    .Size = 15
    .Bold = True
    .Color = vbRed
End With

End Sub

Open in new window

0
 
LVL 81

Expert Comment

by:byundt
ID: 39629070
If worksheet Yearly_Totals is not the active sheet when the HarryHYLee's macro is run, you will get unexpected results. The following tweak to that code will circumvent those problems.

Note: the sample workbook posted in the question does not have a worksheet named "Yearly_Totals". I used worksheet Sheet1 instead in the code below.
Sub AddColumnSummary()

Dim Clmns As Long, Rws As Long, Clmn As Long, Rng As Range

'With Worksheets("Yearly_Totals")
With Worksheets("Sheet1")
    Clmns = .Cells(1, Columns.Count).End(xlToLeft).Column
    Rws = .Cells(Rows.Count, 1).End(xlUp).Row
    
        For Clmn = 5 To Clmns
            Set Rng = .Range(.Cells(2, Clmn), .Cells(Rws, Clmn))
            .Cells(Rws + 2, Clmn).Formula = "=SUM(" & Rng.Address & ")"
        Next
            
        For Clmn = 5 To Clmns - 2
            .Cells(Rws + 3, Clmn).Formula = "=" & .Cells(Rws + 2, Clmn).Address & "/" & .Cells(Rws + 2, Clmns - 1).Address
        Next
    
    With Range(.Cells(Rws + 1, 1), .Cells(Rws + 2, Clmns))
        .Interior.Color = vbYellow
        .Font.Bold = True
    End With
    With Range(.Cells(Rws + 3, 5), .Cells(Rws + 3, Clmns - 2))
        .Font.Color = vbRed
        .Style = "Percent"
        .NumberFormat = "0.00%"
    End With
    
    With .Cells(Rws + 2, Clmns - 1).Font
        .Size = 15
        .Bold = True
        .Color = vbRed
    End With
End With

End Sub

Open in new window

0
 

Author Comment

by:W.E.B
ID: 39629097
Hello,
appreciate the help,
please see attached.

it works on sheet 1
but not on sheet2, sheet3.

thanks
sample2.xlsx
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 12

Expert Comment

by:Harry Lee
ID: 39629104
byundt,

You can do better than simply change the reference of other people's work.
0
 
LVL 81

Expert Comment

by:byundt
ID: 39629106
You will need to clear the cells with error values on Sheet2 and Sheet3. The following macro will then work:
Sub AddColumnSummary()

Dim Clmns As Long, Rws As Long, Clmn As Long
Dim ws As Worksheet
Dim Rng As Range

For Each ws In ActiveWorkbook.Worksheets
    With ws
        Clmns = .Cells(2, Columns.Count).End(xlToLeft).Column
        Rws = .Cells(Rows.Count, 1).End(xlUp).Row
        
            For Clmn = 5 To Clmns
                Set Rng = .Range(.Cells(2, Clmn), .Cells(Rws, Clmn))
                .Cells(Rws + 2, Clmn).Formula = "=SUM(" & Rng.Address & ")"
            Next
                
            For Clmn = 5 To Clmns - 2
                .Cells(Rws + 3, Clmn).Formula = "=" & .Cells(Rws + 2, Clmn).Address & "/" & .Cells(Rws + 2, Clmns - 1).Address
            Next
        
        With Range(.Cells(Rws + 1, 1), .Cells(Rws + 2, Clmns))
            .Interior.Color = vbYellow
            .Font.Bold = True
        End With
        With Range(.Cells(Rws + 3, 5), .Cells(Rws + 3, Clmns - 2))
            .Font.Color = vbRed
            .Style = "Percent"
            .NumberFormat = "0.00%"
        End With
        
        With .Cells(Rws + 2, Clmns - 1).Font
            .Size = 15
            .Bold = True
            .Color = vbRed
        End With
    End With
Next
End Sub

Open in new window

0
 
LVL 12

Accepted Solution

by:
Harry Lee earned 250 total points
ID: 39629111
Wass_QA,

I have changed the way the macro works a little bit.

Instead of hardcoding the sheet name, it's now using Activesheet.

I have also changed the column count to use 2nd row instead of the 1st row.

Since you have a lot of too small columns, I have added Columns.Autofit at the end.

Sub AddColumnSummary()

Dim WS As Worksheet, Clmns As Long, Rws As Long, Clmn As Long, Rng As Range

Set WS = ActiveSheet
Clmns = WS.Cells(2, Columns.Count).End(xlToLeft).Column
Rws = WS.Cells(Rows.Count, 1).End(xlUp).Row

    For Clmn = 5 To Clmns
        Set Rng = WS.Range(Cells(2, Clmn), Cells(Rws, Clmn))
        WS.Cells(Rws + 2, Clmn).Formula = "=Sum(" & Rng.Address & ")"
    Next
        
    For Clmn = 5 To Clmns - 2
        WS.Cells(Rws + 3, Clmn).Formula = "=Average(" & Cells(Rws + 2, Clmn).Address & "/" & Cells(Rws + 2, Clmns - 1).Address & ")"
    Next

With Range(Cells(Rws + 1, 1), Cells(Rws + 2, Clmns))
    .Interior.Color = vbYellow
    .Font.Bold = True
End With
With Range(Cells(Rws + 3, 5), Cells(Rws + 3, Clmns - 2))
    .Font.Color = vbRed
    .Style = "Percent"
    .NumberFormat = "0.00%"
End With

With Cells(Rws + 2, Clmns - 1).Font
    .Size = 15
    .Bold = True
    .Color = vbRed
End With
Columns.AutoFit
End Sub

Open in new window

0
 
LVL 81

Expert Comment

by:byundt
ID: 39629117
HarryHYLee,
I gave you full credit for the code at the beginning of my opening Comment.

My contributions in this thread are minor tweaks to that code, made necessary only because the Asker changed the problem. I am sorry that those efforts gave offense.


Brad
0
 

Author Comment

by:W.E.B
ID: 39629128
Thanks a million guys,
works great.
0

Featured Post

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

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

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

751 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