Storing Multiple Selected Pivot Table Report Filter Values

[marston.gould]

Hi - I have a pivot table that uses a large number of report filters.
These report filters each can have multiple selected values.
I would like to be able to capture the selections in the pivot table and store them in a worksheet so that at a later time, a user could reselect all of the specific combinations they made previously without having to reselect each of the report filters and reset them.

Example:
Report Filter 1: Possible Values A,B,C,D,E
Report Filter 2: Possible Values F,G,H,I,J
Report Filter 3: Possible Values K,L,M,N,O

User selected values:
Report Filter 1: A,C,E
Report Filter 2: F,G,I
Report Filter 3: K,L

this would be stored as scenario 1

I'd like scenario 1 to be available after the file has been saved/closed and reopened.

 

[marston.gould]

And to make one clarification - the problem I'm really struggling with is how to store the multiple items bit. I get that if a user only selections (all) or makes a unique selection that its pretty straightforward.

I just can't for the life of me figure out a simple way to store the multiple items piece.

One other piece of information - the items in each of the report filters are all unique - although it would be better if I didn't have to depend on this.

 

[minimaster]

I'm posting here some a code snippet which I use to save complete
pivot table layouts for later restoration on demand:

It won't run since there are quite a lot of other routines required,
but it will illustrate what you are after.

Sub savePT_layout()
Dim objPF As PivotField
Dim intRow As Integer
Dim firstRow As Integer
Dim nRow As Integer
Dim Wn As Worksheet

Dim dataset As Integer
Dim ws As Worksheet
Dim PT As PivotTable
Dim pfItem As PivotItem
Dim c As Range
Dim i As Integer


On Error GoTo savePT_layout_Error

Set PT = getPivotTable
If PT Is Nothing Then
MsgBox "Error: Can't find pivot table on the active sheet!"
Exit Sub
End If
Call AppSwitch(False)
Call EnsureLayoutStoreExists
Set ws = Worksheets(FIELDsheet)
Set Wn = Worksheets(LAYOUTsheet)

nRow = LastCell(Wn).Row + 1
If nRow = 2 Then
dataset = 1
Else
dataset = Wn.Cells(nRow - 1, 1).Value + 1
End If

intRow = LastCell(ws).Row
firstRow = intRow + 1
PT.Parent.Activate
Call AppSwitch(True)
initBar PT.VisibleFields.Count * 10, "save... "
Debug.Print PT.VisibleFields.Count * 10
i = 1
For Each objPF In PT.VisibleFields

Call AppSwitch(True)
objPF.LabelRange.Select
updateBar i * 10
Call AppSwitch(False)
i = i + 1
intRow = intRow + 1

ws.Cells(intRow, 1).Value = dataset
ws.Cells(intRow, 2).Value = objPF.Caption
On Error Resume Next ' for "Data" labels
ws.Cells(intRow, 3).Value = objPF.SourceName
On Error GoTo savePT_layout_Error
' If Left(objPF.Name, 3) = "Sum" Then Stop
Select Case objPF.Orientation
Case xlRowField
ws.Cells(intRow, 4).Value = xlRowField
ws.Cells(intRow, 5).Value = "xlRowField"
ws.Cells(intRow, 6).Value = objPF.Position
ws.Cells(intRow, 7).Value = objPF.VisibleItems.Count
On Error Resume Next ' Data fields don't like this
objPF.Orientation = xlPageField ' temporary pagefield
settings
On Error GoTo savePT_layout_Error
objPF.Orientation = xlRowField ' restore columnfield
settings
objPF.Position = ws.Cells(intRow, 6).Value
ws.Cells(intRow, 10).Value = objPF.TotalLevels
Set c = ws.Cells(intRow, 21)
On Error Resume Next
For Each pfItem In objPF.VisibleItems
c(1, pfItem.Position) = pfItem.Name
Next pfItem
On Error GoTo savePT_layout_Error
If objPF.Name = "ProjectDetailDate" Then
' Stop ' group Debug.Print
g(5)
Else
' Stop
End If
Case xlColumnField
ws.Cells(intRow, 4).Value = xlColumnField
ws.Cells(intRow, 5).Value = "xlColumnField"
ws.Cells(intRow, 6).Value = objPF.Position
ws.Cells(intRow, 7).Value = objPF.VisibleItems.Count
On Error Resume Next ' Data fields don't like this
objPF.Orientation = xlPageField ' temporary pagefield
settings
ws.Cells(intRow, 9).Value =
objPF.CurrentPage.LabelRange.Text
On Error GoTo savePT_layout_Error
objPF.Orientation = xlColumnField ' restore columnfield
settings
objPF.Position = ws.Cells(intRow, 6).Value
ws.Cells(intRow, 10).Value = objPF.TotalLevels
Set c = ws.Cells(intRow, 21)
On Error Resume Next
For Each pfItem In objPF.VisibleItems
c(1, pfItem.Position) = pfItem.Name
Next pfItem
On Error GoTo savePT_layout_Error
Case xlPageField
ws.Cells(intRow, 4).Value = xlPageField
ws.Cells(intRow, 5).Value = "xlPageField"
ws.Cells(intRow, 6).Value = objPF.Position
ws.Cells(intRow, 8).Value = objPF.CurrentPage
ws.Cells(intRow, 9).Value =
objPF.CurrentPage.LabelRange.Text
Set c = ws.Cells(intRow, 21)
objPF.Orientation = xlRowField ' temporary a rowfield
to read it properly
ws.Cells(intRow, 7).Value = objPF.VisibleItems.Count
'PivotItems.Count
On Error Resume Next
For Each pfItem In objPF.PivotItems
If pfItem.Visible = True Then
c(1, pfItem.Position) = pfItem.Name
End If
Next pfItem
On Error GoTo savePT_layout_Error
objPF.Orientation = xlPageField ' restore pagefield
settings
objPF.Position = ws.Cells(intRow, 6).Value
objPF.CurrentPage = CStr(ws.Cells(intRow, 8))
Case xlDataField
ws.Cells(intRow, 4).Value = xlDataField
ws.Cells(intRow, 5).Value = "xlDataField"
ws.Cells(intRow, 6).Value = objPF.Position
ws.Cells(intRow, 8).Value = objPF.Function
' ws.Cells(intRow, 8).Value = objPF.Orientation
Case xlHidden
' ws.Cells(intRow, 5).Value = xlHidden
' ws.Cells(intRow, 6).Value = "xlHidden"
intRow = intRow - 1
End Select
Next objPF
clearBar

' sort by Orientation and 2nd by position
ws.Rows(firstRow & ":" & intRow).Sort _
Key1:=ws.Cells(firstRow, 4), _
Key2:=ws.Cells(firstRow, 6)
' assemble std. Name
setName = ws.Cells(intRow, 2)
Do
intRow = intRow - 1
Select Case ws.Cells(intRow, 4)
Case xlPageField
If ws.Cells(intRow, 8) = "(All)" And ws.Cells(intRow, 7) <
4 Then
For i = 1 To ws.Cells(intRow, 7)
If i = 1 Then
setName = setName & " " & ws.Cells(intRow, 20
+ i)
Else
setName = setName & ", " & ws.Cells(intRow, 20
+ i)
End If
Next i
Else
setName = setName & " " & ws.Cells(intRow, 2) & ":" &
ws.Cells(intRow, 8)
End If
Case Else
If ws.Cells(intRow, 7) < 4 Then
For i = 1 To ws.Cells(intRow, 7)
If i = 1 Then
setName = setName & ", for " &
ws.Cells(intRow, 20 + i)
Else
setName = setName & "-" & ws.Cells(intRow, 20
+ i)
End If
Next i
Else
setName = setName & ", by " & ws.Cells(intRow, 2)
End If
End Select
Loop While ws.Cells(intRow - 1, 1) = dataset

Call AppSwitch(True)
UserFormPT_layout_title.Show
' setName = InputBox("Enter description for pivot table
layout", "Enter description", setName)
If setName <> "" Then
Call AppSwitch(False)
Wn.Cells(nRow, 1) = dataset
Wn.Cells(nRow, 2) = setName
Wn.Cells(nRow, 3) = Now()
Wn.Cells(nRow, 4) = PT.Name
Wn.Cells(nRow, 5) = PT.Parent.Name
Wn.Cells(nRow, 6) = PT.PivotCache.Index

Dim ch As Chart
For Each ch In ActiveWorkbook.Charts 'nSheet.ChartObjects
If ch.HasPivotFields Then
If ch.PivotLayout.PivotTable.Name = PT.Name Then
Wn.Cells(nRow, 7) = ch.Name
Wn.Cells(nRow, 8) = ch.Type
Wn.Cells(nRow, 9) = ch.ChartType
Wn.Cells(nRow, 10) = "Chartsheet"
Wn.Cells(nRow, 11) = ch.Name
Wn.Cells(nRow, 12) = ch.HasDataTable
If ch.HasDataTable Then Wn.Cells(nRow, 13) =
ch.DataTable.ShowLegendKey
End If
End If
Next ch
Dim shp As Shape
If Wn.Cells(nRow, 7) = "" Then
Dim nSheet As Worksheet
For Each nSheet In Worksheets
For i = 1 To nSheet.ChartObjects.Count
With nSheet.ChartObjects(i).Chart
If .HasPivotFields Then
If .PivotLayout.PivotTable.Name = PT.Name
Then
Wn.Cells(nRow, 7) = .Parent.Name
Wn.Cells(nRow, 8) = .Type
Wn.Cells(nRow, 9) = .ChartType
Wn.Cells(nRow, 10) = "embedded"
Wn.Cells(nRow, 11) = nSheet.Name
Wn.Cells(nRow, 12) = .HasDataTable
If .HasDataTable Then Wn.Cells(nRow,
13) = .DataTable.ShowLegendKey
End If
End If
End With
Next i
Next nSheet
End If
Else

End If
Call AppSwitch(True)

On Error GoTo 0
Exit Sub

savePT_layout_Error:
clearBar
MsgBox "Error " & err.Number & " (" & err.Description & ") in
procedure savePT_layout of Module Pivot_Layout_Mngr"
End Sub