Home > Enterprise >  Calculate percentage through multiple sheets in VBA
Calculate percentage through multiple sheets in VBA

Time:08-18

I have an Excel file with many sheets that look similar to this :

Q1 N
1 36
2 78
3 101
4 132

The number of lines can differ from one sheet to the other but they always have two columns.

What I am trying to do is to calculate a sum for the B column and use that to then calculate the share of each answer in column C as such:

Q1 N %
1 36 10 %
2 78 22 %
3 101 29 %
4 132 38 %
437 100 %

I have managed to calculate the sum across all sheets (see code below) but I have trouble understanding how to calculate the percentage. Any clues would be appreciated!

Sub Clean_up()
'
' Clean_up Macro
'

'
For Each sht In ActiveWorkbook.Worksheets
  If sht.Visible Then
    sht.Activate
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "0"
 
    [C1].Value = "%"

    Range("A1").End(xlDown).Offset(1, 0).Select
    ActiveCell = "NA"

    Range("B1").End(xlDown).Offset(1, 0).Select
    ActiveCell = Application.WorksheetFunction.Sum(Range("B:B"))

End If

Next sht

End Sub

CodePudding user response:

Sub Clean_Up()

    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim total As Double
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible Then
            
            ws.Columns("B").NumberFormat = "0"
            ws.Columns("C").NumberFormat = "0.00%"
            
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            For r = 2 To lastRow
                total = total   ws.Cells(r, 2).Value
            Next r
            ws.Cells(lastRow   1, 2).Value = total
            ws.Cells(lastRow   1, 3).Value = 1
            
            ' Place percentages
            For r = 2 To lastRow
                ws.Cells(r, 3).Value = ws.Cells(r, 2).Value / total
            Next r
            
        End If
    Next

End Sub

CodePudding user response:

Quick examples of taking generating a percentage:

'Inserting a formula to the cell:
With sheets(1)
    .range(.cells(1,3),.cells(4,3)).formula = "=B1/Sum(B$1:B$4)"
End with

'Outputting a value to the cell
With sheets(1)
    dim sumOfValues as double:  sumofValues = Application.Sum(.range(.cells(1,3),.cells(4,3)))
    dim iterator as long
    for iterator = 1 to 4
        .cells(iterator,3).value = .cells(iterator,2).value/sumOfValues
    next iterator
End with

You would dynamically want to find your ranges first/last row, though the above would get you the percentage part.

  • Related