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.
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:
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_one:
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:
Dim nm As Excel.Name
For Each nm In ws.Names
If InStr(nm.Name, "!_" & pvt.Name) > 0 Then
nm.Delete
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”:
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.
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):
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.
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.
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
Else
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
Next
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"
Else
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.Select
wksOutput.Cells.Clear
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.
Pingback: Introducing…Structured References for PivotTables | Chandoo.org - Learn Microsoft Excel Online