CODEWITHSUNDEEP
vbaexcel-formula
skt
skt

Reputation: 599

How to Add Percentage Column at last in Pivot Sheet using VBA in Excel

Hi I need the expert help. I have created the Pivot table by VBA code. Now I would like to create percentage column should be added to the Pivot table tab to show the number of complaints as a percentage of the total. The percentage should be displayed to the nearest whole number Pivot table will display as follows :

Formula for P3 = (O3/Grand Total)% or [ (169/690)%]= 24.49

enter image description here

I have created the subroutine for this as below But I don't know how to implement the formula.

Sub AddPercentage()

       Dim PSheet As Worksheet
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim CellData As Variant

Set PSheet = Worksheets("Pivot")

'Define Data Range
LastRow = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = PSheet.Cells(1, Columns.Count).End(xlToLeft).Column

' Grand Total value, This will be use for Percentage
CellDat = PSheet.Cells(LastRow, 15)

PSheet.Columns("P:P").Insert
PSheet.Range("P1").Value= "Heading % "

' I need to replace the below value by acctual formula
PSheet.Range("P2").Value= "= Replaced by actual Formula "

' I need to replace the below value by acctual formula
PSheet.Range("P3:P" & LastRow + 1).Value= "= Replaced by actual Formula "
    
End Sub

Upvotes: 0

Views: 298

Answers (2)

Bharat
Bharat

Reputation: 1205

Try with this

    Sub AddPercentage()

    Dim PSheet As Worksheet
    Dim PRange As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Dim CellData As Variant
    
    Set PSheet = Worksheets("Sheet1")
    
    'Define Data Range
    LastRow = PSheet.Cells(rows.Count, 1).End(xlUp).Row
    LastCol = PSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    
    ' Grand Total value, This will be use for Percentage
    CellDat = PSheet.Cells(LastRow, LastCol)
    
    PSheet.Columns("P:P").Insert
    PSheet.Range("P1").Value = "Heading % "
        
    PSheet.Range("P3").Value = "= (O3/" & CellDat & ")"
    
    n = PSheet.Range("P3", PSheet.Range("P3").End(xlDown).rows).Count
    Range("P3:P" & n + 1).NumberFormat = "0.00%"
        
    PSheet.Range("P3:P" & n + 1).Value = "= (D3/" & CellDat & ")"
    
End Sub

Upvotes: 1

skt
skt

Reputation: 599

Dim PSheet As Worksheet Dim PRange As Range Dim LastRow As Long Dim LastCol As Long Dim CellData As Variant Dim n As Integer

Set PSheet = Worksheets("Pivot")

'Define Data Range
LastRow = PSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = PSheet.Cells(1, Columns.Count).End(xlToLeft).Column

' Grand Total value, This will be use for Percentage
CellDat = PSheet.Cells(LastRow, 15)

PSheet.Columns("P:P").Insert
PSheet.Range("P2").Value = "Heading % "
    
PSheet.Range("P3").Value = "= (O3/" & CellDat & ")*100"
    
PSheet.Range("P3:P" & LastRow - 1).Value = "= (O3/" & CellDat & ")*100"

End Sub

Upvotes: 0

Related Questions