Create Pivot Table Named Ranges

Create Pivot Table Named Ranges

I need to calculate percentiles from subsets of data in a pivot table. In order to refer to pivot table fields, it sure would be nice if they had dynamic named ranges. So I wrote some code to create pivot table named ranges.

pivot table named range generator intellisense

Programming pivot tables is fun. The extensive object model is a VBA wonderland with treats around every turn. There are great web sites out there with excellent pivot table coding samples – Contextures leaps to mind. In terms of identifying PivotFields, DataFields and other pivot table ranges, Jon Peltier wrote a superb post in 2009 that’s still generating discussion.

My code is pretty simple. It cycles through the data fields, and any other visible fields, in the specified pivot table and adds a named range for each one to the pivot table’s worksheet:

Sub RefreshPivotNamedRanges(pvt As Excel.PivotTable)
Dim ws As Excel.Worksheet
Dim pvtField As Excel.PivotField
Dim FieldType As String

With pvt
    Set ws = .Parent
    ClearOldNames ws, pvt
    For Each pvtField In .DataFields
        AddNamedRange ws, pvt.Name, "Data", pvtField.SourceName, pvtField.DataRange.Address
    Next pvtField
    For Each pvtField In .PivotFields
        Select Case pvtField.Orientation
        Case xlHidden
            GoTo next_one
        Case xlPageField
            FieldType = "Page"
        Case xlDataField
            FieldType = "Data"
        Case xlRowField
            FieldType = "Row"
        Case xlColumnField
            FieldType = "Col"
        End Select
        AddNamedRange ws, pvt.Name, FieldType, pvtField.Name, pvtField.DataRange.Address
    Next pvtField
End With
End Sub

The PivotField.Orientation property has five enumerated constants that tell you what type of field it is – xlDataField, xlRowField, etc. The For/Next loop skips over the ones that come up xlHidden and processes the rest. Strangely, even though there’s a xlDataField type, and even though I can refer to pvt.PivotFields(“Sum of Home Runs”), the data fields don’t actually show up when cycling through the PivotFields. Instead, to get those fields the code first cycles through the pivot table’s DataFields collection.

When calling the AddNamedRange routine for a DataField, the codes passes its SourceName, not the Name. So in this example, the new name will include “Home Runs,” not “Sum of Home Runs.” You may want to pass the Name instead.

This next routine does what it says and clears out the previous range names associated with the pivot table. It’s not fool-proof. For example, if the pivot table name was changed, it won’t find the range names. I should probably use the pivot table’s Tag property to store names that won’t get changed:

Sub ClearOldNames(ws As Excel.Worksheet, pvt As Excel.PivotTable)
Dim nm As Excel.Name

For Each nm In ws.Names
    If InStr(nm.Name, "!_" & pvt.Name) > 0 Then
    End If
Next nm
End Sub

The routine below adds the worksheet-level names to the pivot table’s sheet. It calls a function that replaces spaces and other characters that aren’t allowed in range names (code at the end of the post). It also adds a “_” at the beginning of the name to hopefully avoid illegal names like “A1”:

Sub AddNamedRange(ByRef ws As Excel.Worksheet, ByVal PivotName As String, ByVal FieldType As String, ByVal PivotFieldName As String, ByVal PivotFieldAddress As String)
Dim CleanedRangeName As String

CleanedRangeName = "_" & GetCleanedRangeName(PivotName & "_" & FieldType & "_" & PivotFieldName, "_")
ws.Names.Add Name:=CleanedRangeName, RefersTo:="=" & PivotFieldAddress & ""
End Sub

To automate this stuff, put the code in a regular module and call RefreshPivotNamedRanges from a PivotTableUpdate event. The names will be regenerated each time the pivot table is refreshed, either manually or when you drag a field, or however.

Create Pivot Table Named Ranges - Name Manager 1

So now my Percentile array formula can find the value for the selected year and percentile:

Here’s the code to get the legal range names. You’ll need to set a reference to Microsoft VBScript Regular Expressions (at least if you’re an early binder):

Function GetCleanedRangeName(RangeName As String, SpaceReplacement As String) As String
Dim NewName As String

'the "\" character escapes the Regex "reserved" characters
'x22 is double-quote
NewName = Regex_Replace(RangeName, "[\\\^\|\(\)\[\]\$\{\}\-x22/`~!@#%&=;:<>]", "", False)
'get rid of multiple contiguous spaces
NewName = Application.WorksheetFunction.Trim(NewName)
'255 is the length limit for a legal name
NewName = Left(Replace(NewName, " ", SpaceReplacement), 255)
GetCleanedRangeName = NewName
End Function

Function Regex_Replace(OriginalString As String, Pattern As String, Replacement, varIgnoreCase As Boolean) As String
' Function matches pattern, returns true or false
' varIgnoreCase must be TRUE (match is case insensitive) or FALSE (match is case sensitive)
' Use this string to replace double-quoted substrings - """[^""\r\n]*"""
Dim objRegExp As VBScript_RegExp_55.RegExp

Set objRegExp = New VBScript_RegExp_55.RegExp
With objRegExp
    .Pattern = Pattern
    .IgnoreCase = varIgnoreCase
    .Global = True
End With
Regex_Replace = objRegExp.Replace(OriginalString, Replacement)
Set objRegExp = Nothing
End Function

This has undergone a massive .5 days of testing, so I can guarantee there’s glitches. But if you’d like to give it a spin, here you go. It’s an Excel 2007/10 file as earlier versions don’t support the “Repeat All Item Labels” pivot setting that I rely on for the Percentile array formula. Other than that, it works just as well in Excel 2003.

3 thoughts on “Create Pivot Table Named Ranges

  1. Hi Doug. Great post. I never would have known about your blog had you not posted a link to Jon Peltier’s pivottable post in this article. You’ve got some great content here, and I look forward to digesting it further.

    As discussed in the comments of Jon’s blog, I had a crack at writing routine that stores visible pivotitems and their associated pivotfields as:
    1. an array of arrays (i.e. jagged array); and
    2. A collection nested within a collection
    …so that users can save the settings that make up their newly filtered pivottable to a new worksheet, so that subsequent code can then reconstruct their custom pivottable view from those settings .

    I’ve now worked out how to do this using a dictionary of dictionaries, in case you or any of your readers are interested.

    This uses early binding i.e. you have to explicitly add a reference to the Microsoft Scripting Runtime library.

    Sub PT_Dictionary()
        Dim pf As PivotField
        Dim pt As PivotTable
        Dim pi As PivotItem
        Dim i As Integer
        Dim j As Integer
        Dim dicFields As Scripting.Dictionary
        Dim dicPF_Settings As Scripting.Dictionary
        Dim dicPF_PivotItems As Scripting.Dictionary
        Dim dicPF_All As Scripting.Dictionary

        Dim varPI As Variant
        Dim varFieldKey As Variant
        Dim VarSettingsKey As Variant
        Dim lFieldNumber As Long
        Dim lSettingNumber As Long
        Dim wksOutput As Worksheet
        Dim bWorksheetExists As Boolean
        Dim wks As Worksheet

        'testing settings
       'Set pt = Sheet2.PivotTables(1)

        'Determine which PivotTable to use as the source
           On Error Resume Next
            Set pt = ActiveCell.PivotTable
            If Err.Number <> 0 Then
                MsgBox "Please select a pivot table and try again"
                Exit Sub
                On Error GoTo 0
                Set pt = ActiveCell.PivotTable
            End If

        'Locate or create a worksheet to dump the pivotfields into
       bWorksheetExists = False
        For Each wks In ActiveWorkbook.Worksheets
            If wks.Name = "PivotFields" Then
                Set wksOutput = wks
                bWorksheetExists = True
                Exit For
            End If
        If bWorksheetExists = False Then
            Set wksOutput = Sheets.Add
            wksOutput.Name = "PivotFields"
        End If
        Set wksOutput = Worksheets("PivotFields")

        'Create master dictionary
       'This will later be populated with sub-dictionaries for each
       'visible PivotField, that each contain a list of field settings
       ' ( dicPF_Settings), and a list of pivotitems (dicPF_PivotItems)
       Set dicFields = New Scripting.Dictionary

        'Cycle through all visible pivotfields, excluding totals
       For Each pf In pt.VisibleFields
            If pf.Name <> "Data" Then
                If pf.Name <> "Values" Then
                Select Case pf.Orientation
                Case xlColumnField, xlRowField, xlPageField

                    'Create dicPF_PivotItems: a dictionary for each PivotField that contain visible PivotItems
                   Set dicPF_PivotItems = New Scripting.Dictionary
                    If pf.AllItemsVisible Then
                        dicPF_PivotItems.Add "All", "All"
                        For Each pi In pf.PivotItems
                            If pi.Visible Then
                                dicPF_PivotItems.Add pi.Name, pi.Name
                            End If
                        Next pi
                    End If

                    'Create dicPF_Settings: a dictionary for each PivotField that contains PivotField settings e.g. layout
                   Set dicPF_Settings = New Scripting.Dictionary
                    dicPF_Settings.Add "Orientation", pf.Orientation
                    dicPF_Settings.Add "Position", pf.Position

                    'Create dicPF_All: a dictionary for each PivotField that contains that field's dicPF_Settings and dicPF_PivotItems
                   Set dicPF_All = New Scripting.Dictionary
                    dicPF_All.Add "Settings", dicPF_Settings
                    dicPF_All.Add "PivotItems", dicPF_PivotItems

                    'Write dicPF_All to the dicFields master dictionary
                   dicFields.Add pf.Name, dicPF_All
                End Select
            End If
            End If
        Next pf
        varFieldKey = dicFields.Keys

        ' Write the parent Dictionary's keys (i.e., the distinct Code values) to the worksheet
        wksOutput.Cells(1, 1).value = "Visible Fields"
        wksOutput.Cells(1, 2).Resize(1, UBound(varFieldKey) + 1).value = varFieldKey  'The +1 is required because varFieldKey is a zero-based array
       'Loop through the parent keys and retrieve each child Dictionary in turn
       For lFieldNumber = 0 To UBound(varFieldKey)
            Set dicPF_Settings = dicFields.Item(varFieldKey(lFieldNumber)).Item("Settings")
            Set dicPF_PivotItems = dicFields.Item(varFieldKey(lFieldNumber)).Item("PivotItems")

            'Loop through each of the stored settings and write them to the worksheet
           VarSettingsKey = dicPF_Settings.Keys
            For lSettingNumber = 0 To UBound(VarSettingsKey)
                wksOutput.Cells(2 + lSettingNumber, 1).value = VarSettingsKey(lSettingNumber)
                wksOutput.Cells(2 + lSettingNumber, lFieldNumber + 2).value = dicPF_Settings(VarSettingsKey(lSettingNumber))
            Next lSettingNumber

            'Loop through each of the stored pivotitoms and write them to the worksheet
           varPI = dicPF_PivotItems.Keys
            wksOutput.Cells(UBound(VarSettingsKey) + 3, lFieldNumber + 2).Resize(UBound(varPI) + 1, 1).value = Application.Transpose(varPI)
        Next lFieldNumber

        Set dicFields = Nothing
        Set dicPF_All = Nothing
        Set dicPF_Settings = Nothing
        Set dicPF_PivotItems = Nothing

    End Sub
    • Jeff, thanks for the kind words. And for the code. That’s an interesting project, please keep me posted.

      One thing I noticed is PivotFields.AllVisibleItems isn’t available before Excel 2007, so I get a runtime error in XL 2003. Runs fine in XL 2010.

  2. Pingback: Introducing…Structured References for PivotTables | - Learn Microsoft Excel Online

Speak Your Mind

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

To post code, do this: <code> your vba here </code>