Pivot Calculation

[galmond1010]

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]

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.

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]

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]

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.

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

 

[galmond1010]

Thank you very much for your help. Have a great weekend.