Pivot tables

Here’s a quick snippet that will set the current pivot table to tabular layout, turn off all subtotals and repeat all item labels (2010 and later):

Sub FlatPivot()
    Dim PT                    As Excel.PivotTable

    On Error Resume Next
    Set PT = ActiveCell.PivotTable
    On Error GoTo 0

    If Not PT Is Nothing Then
        Application.CommandBars.ExecuteMso "PivotTableSubtotalsDoNotShow"
        PT.RowAxisLayout xlTabularRow
        PT.RepeatAllLabels xlRepeatLabels
    End If
End Sub

I have seen hundreds of posts over the years about how to make a pivot table always default to Sum (even with blank cells or an occasional text entry) or a particular number format. Sadly there is no way to simply set a default, so one of my most commonly used code snippets sets all the data fields in the currently selected pivot table to Sum and uses a simple #,##0 number format:

Public Sub SetDataFieldsToSum()
'
' Sets all data fields to sum
' Created: 21/11/2005
' Created by: Rory
'
   Dim PT                          As PivotTable
    Dim ptf                         As PivotField

    On Error Resume Next
    Set PT = ActiveCell.PivotTable
    On Error GoTo 0

    If PT Is Nothing Then
        MsgBox "Please select a cell within a pivot table before running this code!"
    Else
        With PT
            .ManualUpdate = True
            For Each ptf In .DataFields
                With ptf
                    .Function = xlSum
                    .NumberFormat = "#,##0"
                End With
            Next ptf
            .ManualUpdate = False
        End With
    End If
End Sub

This code will attempt to refresh each pivot table in the active workbook in turn and report the location of any pivot table that cannot be refreshed. Useful for mysterious errors when you use RefreshAll… 😉

Sub RefreshPivots()
    Dim ws As Worksheet
    Dim pt As PivotTable
   
    On Error GoTo err_handler
   
    For Each ws In ActiveWorkbook.Worksheets
        For Each pt In ws.PivotTables
            pt.RefreshTable
        Next pt
    Next ws
   
    Exit Sub
   
err_handler:
    MsgBox "Error occurred during refresh:" & vbCrLf & _
            "Pivot table name: " & pt.Name & vbCrLf & _
            "on sheet: " & ws.Name & vbCrLf & _
            "at range: " & pt.TableRange1.Address(0, 0)
End Sub

This one does exactly what it says on the tin (2007 or later):

Sub RemovePivotSubtotals()
    ' removes all Subtotals from the current pivot table
   Dim PT                          As PivotTable
    Dim pf                          As PivotField
   
    On Error Resume Next
    Set PT = ActiveCell.PivotTable
    If PT Is Nothing Then Exit Sub
   
    Application.CommandBars.ExecuteMso "PivotTableSubtotalsDoNotShow"
   
End Sub

A few miscellaneous routines:

Sub RefreshAllPivots()
' this code simply refreshes all the pivot caches in the workbook
' (which should refresh their pivot tables too)
   Dim PC                          As PivotCache

    For Each PC In ActiveWorkbook.PivotCaches
        PC.Refresh
    Next PC
End Sub
Sub Refresh_All_Data_All_Tables()
' A more verbose routine to refresh each pivot cache
' as well as clear out any old data
   Dim PT                          As PivotTable
    Dim ws                          As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
        For Each PT In ws.PivotTables
            PT.PivotCache.MissingItemsLimit = xlMissingItemsNone
            PT.PivotCache.Refresh
        Next PT
    Next ws

End Sub

Sub PrintPivotPages()
' routine to select each item in the first page field
' then print out a copy of the pivot table
   Dim PT                          As PivotTable
    Dim pi                          As PivotItem
    Set PT = ActiveSheet.PivotTables(1)
    For Each pi In PT.PageFields(1).PivotItems
        PT.PageFields(1).CurrentPage = pi.Name
        ActiveSheet.PrintOut
    Next pi
End Sub

And a couple of functions to return column and row field information about a data cell in a pivot table:

Function PivotInfo(rngInput As Range) As String
' A function to return the row and column field information for a specified data cell
   Dim PC                          As PivotCell
    Dim pf                          As PivotField
    Dim pi                          As PivotItem
    Dim strOut                      As String
    On Error Resume Next
    Set PC = rngInput.PivotCell
    On Error GoTo err_handle
    If PC Is Nothing Then
        PivotInfo = "Not a pivot cell"
    Else
        Select Case PC.PivotCellType
        Case xlPivotCellValue  'Any cell in the data area (except a blank row).
           If PC.RowItems.Count Then
                strOut = "Row items: " & vbLf
                For Each pi In PC.RowItems
                    strOut = strOut & pi.Parent.Name & ": " & pi.Value & vbLf
                Next pi
            End If
            If PC.ColumnItems.Count Then
                strOut = strOut & "Column items: " & vbLf
                For Each pi In PC.ColumnItems
                    strOut = strOut & vbLf & pi.Parent.Name & ": " & pi.Value
                Next pi
            End If
            strOut = strOut & PC.PivotField.Name
        Case Else
            strOut = "Not a pivot data cell"
        End Select
    End If
    PivotInfo = strOut
    Exit Function

err_handle:
    PivotInfo = "Unknown error"
End Function
Function PivotFieldInfo(rngInput As Range, strField As String) As String
    ' a function that returns the item from a specific field name
   ' that relates to the specified data cell in a pivot table
   
    Dim PC                          As PivotCell
    Dim pf                          As PivotField
    Dim pi                          As PivotItem
   
    On Error Resume Next
    Set PC = rngInput.PivotCell
    On Error GoTo err_handle
   
    If PC Is Nothing Then
        PivotFieldInfo = "Not a pivot cell"
    Else
        Select Case PC.PivotCellType
        Case xlPivotCellValue  'Any cell in the data area (except a blank row).
           If PC.RowItems.Count Then
                For Each pi In PC.RowItems
                    If pi.Parent.Name = strField Then
                        PivotFieldInfo = pi.Value
                        Exit Function
                    End If
                Next pi
            End If
            If PC.ColumnItems.Count Then
                For Each pi In PC.ColumnItems
                    If pi.Parent.Name = strField Then
                        PivotFieldInfo = pi.Value
                        Exit Function
                    End If
                Next pi
            End If
        Case Else
            PivotFieldInfo = "Not a pivot data cell"
        End Select
    End If
    Exit Function

err_handle:
    PivotFieldInfo = "Unknown error"
End Function

Feel free to use as you wish. Enjoy.

Leave a Reply

Your email address will not be published. Required fields are marked *