Pivot Calculation

galmond1010

New Member
Joined
Apr 15, 2019
Messages
17
I would like to add an additional row in my pivot table for percent of Gross Sales below each of the following categories. Any idea if this can achieved?

Gross Sales POD Expense Commissions Rebate Discount Freight Costs Net Sales
$4,69,655 $293,212 $180,749 $194,139 $57,549 $372,805 $3,592,201

Thank you
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,716
You can use code to read the last row of the pivot table (which contains the column totals) and fill the cells beneath it with the appropriate percentages, however it will not be part of the Pivottable and will have to be rerun whenever the PT is recalculated...which can be done by triggering with a worksheet Pivottable event as follows.

This code must be placed on the code page of the worksheet that contains the PivotTable it will run each time the PT is updated.


Code:
Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    'https://www.mrexcel.com/forum/excel-questions/1099164-pivot-calculation.html
    
    'This code must be placed on the code page of the worksheet that contains
    '  the PivotTable it will run each time the PT is updated.
    'Assuming the first cell of the last row of the DataBodyRange is the Gross
    '  Add % of Gross values below all cells in the row below the DBR
    
    Dim rngCell As Range
    Dim rngDBR As Range     'Databody Range
    Dim rngGRT As Range     'Grand Total Range
    Dim rngGross As Range
    Dim lBorderIndex As Long
    
    'Clear any cells formatted from prior run of this code.  If you have
    '  formatted any cell interior color = 16777214 they will also be cleared
    For Each rngCell In Me.UsedRange
        If rngCell.Interior.Color = 16777214 Then
            rngCell.Interior.Color = xlNone
            rngCell.Borders.LineStyle = xlNone
        End If
    Next
    
    Set rngDBR = ActiveSheet.PivotTables(1).DataBodyRange
    Set rngGRT = rngDBR.Rows(rngDBR.Rows.Count)
    Set rngGross = rngGRT.Cells(1, 1)
    
    'Giving the cells where values will go a slightly offwhite color so they
    '   can be recognized and automatically deleted each time this code is run
    With Union(rngGross.Offset(1, -1), rngGRT.Offset(1, 0))
        .Interior.Color = 16777214
        For lBorderIndex = 7 To 11  'Left, Top, Bottom, Right, Inside Vertical
            With .Borders(lBorderIndex)
                .LineStyle = xlContinuous
                .ThemeColor = 1
                .TintAndShade = -0.14996795556505
                .Weight = xlThin
            End With
        Next
    End With
    
    'Adding Row Name to right of Gross (First column in DBR)
    rngGross.Offset(1, -1).Value = "Percentages"
    
    'Adding values
    For Each rngCell In rngGRT.Offset(1, 0).Cells
        rngCell.Value = rngCell.Offset(-1, 0).Value / rngGross.Value
    Next
    
    'Formatting values
    rngGRT.Offset(1, 0).Cells.NumberFormat = "0.00%"

End Sub
 

galmond1010

New Member
Joined
Apr 15, 2019
Messages
17
it works beautifully. Is it possible to add the same code for multiple pivots on the sheet? Example, the original code adds the percent starting in Cell A7. I have another pivot ending in Cell K6. So the code would need to start in CellL7.I am using water charts and want to display sales, rebates, etc below the chart. I have several charts with pivots on a few tabs. Thoughts?
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,716
This code will update the percentages for all PT on a worksheet when any PT is updated.

I generally have only a single PT on a worksheet since their size can vary radically when new column/row fields are added. They can expand to wipe out other existing data. I assume that if your PT are not radically changing from week to week you are not likely to see one PT overwrite another.

Code:
Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    'https://www.mrexcel.com/forum/excel-questions/1099164-pivot-calculation.html
    
    'This code must be placed on the code page of the worksheet that contains
    '  the PivotTables.  It will remove old column percent values from all
    '  PivotTables and recalculate them for each PT each time any PT is updated.
    'Assumes the first cell of the last row of the DataBodyRange is the Gross.
    'Adds % of Gross values below all cells in the row below PT DataBodyRange
    
        
    Dim rngCell As Range
    Dim pt As PivotTable
    Dim rngDBR As Range     'Databody Range
    Dim rngGTR As Range     'Grand Total Range (last row in DBR)
    Dim rngGross As Range   'First cell in GTR
    Dim lBorderIndex As Long
    
    'Clear any cells formatted from prior run of this code.  If you have
    '  formatted any cell interior color = 16777214 they will also be cleared
    For Each rngCell In Me.UsedRange
        If rngCell.Interior.Color = 16777214 Then
            rngCell.Interior.Color = xlNone
            rngCell.Borders.LineStyle = xlNone
        End If
    Next
    
    For Each pt In Me.PivotTables
    
        Set rngDBR = pt.DataBodyRange
        Set rngGTR = rngDBR.Rows(rngDBR.Rows.Count)
        Set rngGross = rngGTR.Cells(1, 1)
        
        'Giving the cells where values will go a slightly offwhite color so they
        '   can be recognized and automatically deleted each time this code is run
        With Union(rngGross.Offset(1, -1), rngGTR.Offset(1, 0))
            .Interior.Color = 16777214
            For lBorderIndex = 7 To 11  'Left, Top, Bottom, Right, Inside Vertical
                With .Borders(lBorderIndex)
                    .LineStyle = xlContinuous
                    .ThemeColor = 1
                    .TintAndShade = -0.14996795556505
                    .Weight = xlThin
                End With
            Next
        End With
        
        'Adding Row Name to right of Gross (First column in DBR)
        rngGross.Offset(1, -1).Value = "Percentages"
        
        'Adding values
        For Each rngCell In rngGTR.Offset(1, 0).Cells
            rngCell.Value = rngCell.Offset(-1, 0).Value / rngGross.Value
        Next
        
        'Formatting values
        rngGTR.Offset(1, 0).Cells.NumberFormat = "0.00%"
        
    Next

End Sub
 

Forum statistics

Threads
1,081,992
Messages
5,362,603
Members
400,683
Latest member
LogChief

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top