Enumerate subgroups pivottable vba - vba

I have a pivot table structure that looks like (i.e. there are three entries in the "ROWS" box in the pivottable UI)
Category
SubCategory
Sub Sub Category
I know that I can get all the Categories, subcategories, and sub-sub categories by doing (in VBA) PT.PivotFields(3).PivotItems(), PT.PivotFields(2).PivotItems() and PT.PivotFields(1).PivotItems() respectively, where PT is my pivottable.
How can I find out which subcategories are in each category, and same for sub sub categories in categories?
I tried using PT.PivotFields(3).PivotItems()(1).ChildItems() but I get an error <Unable to get the ChildItems property of the PivotItem class> and same for trying ParentItem.
Any idea how I can do this?
An example of what I am looking for. Take the pivot table below, and enumerate (in some way) that:
a has subcategories d,e; b has subcategories e,f; c has sub categories d,e,f; and it would be the same if there were multiple levels on the columns position.

Requirement:
To build a table showing all the Items combinations for all RowFields and ColumnsFields of a given PivotTable.
Solution:
This can be achieved by setting some of the properties and methods of the PivotTable and the Row, Column and Data Fields as follows:
Set these PivotTable properties:
RowGrand, ColumnGrand, MergeLabels, RowAxisLayout
Set these properties for the ColumnFields:
Orientation
Set these properties for the RowFields:
RepeatLabels, Subtotals
Set these properties for the DataFields:
Orientation
Procedure:
Sub PivotTable_Hierarchy_Rows_And_Columns(pt As PivotTable, _
aPtHierarchy As Variant, blClearFilters As Boolean, blIncludeCols As Boolean)
This procedure adjusts all the above-mentioned properties in order to display the PivotTable in a “table like” format generating an array with the PivotTable’s Hierarchy. It also provides the options to clear or not the PivotTable filters and to include or not the ColumnFields in the hierarchy.
Parameters:
Pt: Target PivotTable
aPtHierarchy: Array output containing the hierarchy of the target PivotTable.
blClearFilters: Boolean. Determines whether to clear or not the all PivotTable filters.
blIncludeCols: Boolean. Used to include or not the ColumnFields in the output hierarchy.
Syntax:
Call PivotTable_Hierarchy_Rows_And_Columns(pt, aPtHierarchy, blClearFilters, blIncludeCols)
VBA:
Sub PivotTable_Hierarchy_Rows_And_Columns(pt As PivotTable, _
aPtHierarchy As Variant, blClearFilters As Boolean, blIncludeCols As Boolean)
Dim pf As PivotField
Rem PivotTable Properties & Methods
With pt
.RowGrand = False
.ColumnGrand = False
.MergeLabels = False
.RowAxisLayout xlTabularRow
If blClearFilters Then .ClearAllFilters
End With
Rem ColumnFields Properties
For Each pf In pt.ColumnFields
If blIncludeCols Then
pf.Orientation = xlRowField
Else
pf.Orientation = xlHidden
End If: Next
Rem RowFields Properties
For Each pf In pt.RowFields
With pf
On Error Resume Next
.RepeatLabels = True
.Subtotals = Array(False, False, False, False, _
False, False, False, False, False, False, False, False)
On Error GoTo 0
End With: Next
Rem DataFields Properties
For Each pf In pt.DataFields
pf.Orientation = xlHidden
Next
Rem Set Hierarchy Array
aPtHierarchy = pt.RowRange.Value2
End Sub
Example:
Assuming we need to obtain the Hierarchy of the PivotTable in fig. 1.
Note that the PivotTable has some filters applied.
The procedure PivotTable_Hierarchy_Rows_And_Columns can be called as follows depending on the required outcome:
Sub PivotTable_Hierarchy_Rows_And_Columns_TEST()
Dim pt As PivotTable, aPtHierarchy As Variant
'Set PivotTable - Change worksheet and pivottable name as required
Set pt = ThisWorkbook.Worksheets("Summary").PivotTables("PtTst")
'1. To obtain the Hierarchy for Rows and Columns, clearing all the filters applied to the PivotTable try this:
Call PivotTable_Hierarchy_Rows_And_Columns(pt, aPtHierarchy, True, True) 'See results in Fig. R1 (Table & Array)
‘2. To obtain the Hierarchy for Rows only, clearing all the filters applied to the PivotTable try this:
Call PivotTable_Hierarchy_Rows_And_Columns(pt, aPtHierarchy, True, False) 'See results in Fig. R2 (Table & Array)
'3. To obtain the Hierarchy for Rows and Columns with the filters currently applied to the PivotTable try this:
Call PivotTable_Hierarchy_Rows_And_Columns(pt, aPtHierarchy, False, True) 'See results in Fig. R3 (Table & Array)
'4. To obtain the Hierarchy for Rows only with the filters currently applied to the PivotTable try this:
Call PivotTable_Hierarchy_Rows_And_Columns(pt, aPtHierarchy, False, False) 'See results in Fig. R4 (Table & Array)
End Sub
Fig. 1
Fig. R1
Fig. R2
Fig. R3
Fig. R4
For additional information on the resources used see the following pages:
PivotTable Object (Excel)
PivotTable.RowAxisLayout Method (Excel)
PivotField Object (Excel)

I don't know how many categories and sub-categories you have, but you can put everything to a multiple array (matrix) and then manage like you want.
Try this:
Sub GetCategories_SubCat()
Dim PTable As PivotTable
Dim matrix() As Variant
Dim matrix_s() As Variant
Dim msg$
Set PTable = ActiveSheet.PivotTables("PT")
ReDim matrix(1 To PTable.RowFields.Count)
For i = 1 To PTable.RowFields.Count
matrix(i) = PTable.RowFields(i)
For j = 1 To PTable.RowFields(i).PivotItems.Count
ReDim matrix_s(1 To PTable.RowFields.Count, 1 To PTable.RowFields(i).PivotItems.Count)
matrix_s(i, j) = PTable.RowFields(i).PivotItems(j)
Next j
Next i
End Sub

I think you can use GetPivotData function to try to obtain value for each set of pivot fields. If no error is thrown, you know that certain category has certain sub and sub-sub category. See my rough code, for table with three levels:
Sub ExaminePT()
Dim pt As PivotTable
Dim pf As PivotField
Dim Lev1 As PivotField
Dim Lev2 As PivotField
Dim lev3 As PivotField
Dim pi1 As PivotItem
Dim pi2 As PivotItem
Dim pi3 As PivotItem
Dim checkVal As Double
Set pt = ActiveSheet.PivotTables(1)
For Each pf In pt.PivotFields
If pf.Orientation = xlRowField Then
Select Case pf.Position
Case Is = 1
Set Lev1 = pf
Case Is = 2
Set Lev2 = pf
Case Is = 3
Set lev3 = pf
End Select
End If
Next pf
For Each pi1 In Lev1.PivotItems
For Each pi2 In Lev2.PivotItems
For Each pi3 In lev3.PivotItems
On Error Resume Next
checkVal = pt.GetPivotData("Incremental Benefits 2017", Lev1.Name, pi1.Name, _
Lev2.Name, pi2.Name, lev3.Name, pi3.Name)
If Err.Number = 0 Then Debug.Print pi1 & "| " & pi2 & "| " & pi3
On Error GoTo 0
Next pi3
Next pi2
Next pi1
End Sub
In the first loop I assign category, sub- and subsubcategory to variables, and then do what I had suggested above. The results are written in the Immediate window, this is sketch of the solution.
Probably, with little effort some could turn it into more universal procedure to examine pivot tables for any number of nested levels.

Related

Use VBA to select and deselect multiple slicer items (OLAP data)

I am working on a script which selects only the needed slicer items. I tried using .SlicerItems.Selected = True / False for selecting and deselecting but I am using an OLAP data source in which case .Selected is read-only. The slicer items are in the format of YYYYWW so 7th week of 2018 would be 201807.
I recorded a macro selecting some slicer items and this is what it gave me:
Sub Macro2()
ActiveWorkbook.SlicerCaches("Slicer_YYYYWW").VisibleSlicerItemsList = Array( _
"[Results].[YYYYWW].&[201726]", "[Results].[YYYYWW].&[201727]", _
"[Results].[YYYYWW].&[201728]", "[Results].[YYYYWW].&[201729]", _
"[Results].[YYYYWW].&[201730]", "[Results].[YYYYWW].&[201731]", _
"[Results].[YYYYWW].&[201732]", "[Results].[YYYYWW].&[201733]", _
"[Results].[YYYYWW].&[201734]", "[Results].[YYYYWW].&[201735]", _
"[Results].[YYYYWW].&[201736]", "[Results].[YYYYWW].&[201737]", _
"[Results].[YYYYWW].&[201738]", "[Results].[YYYYWW].&[201739]", _
"[Results].[YYYYWW].&[201740]", "[Results].[YYYYWW].&[201741]", _
"[Results].[YYYYWW].&[201742]", "[Results].[YYYYWW].&[201743]", _
"[Results].[YYYYWW].&[201744]", "[Results].[YYYYWW].&[201745]", _
"[Results].[YYYYWW].&[201746]", "[Results].[YYYYWW].&[201747]", _
"[Results].[YYYYWW].&[201748]", "[Results].[YYYYWW].&[201749]", _
"[Results].[YYYYWW].&[201750]", "[Results].[YYYYWW].&[201751]", _
"[Results].[YYYYWW].&[201801]", "[Results].[YYYYWW].&[201802]", _
"[Results].[YYYYWW].&[201803]")
End Sub
So I tried following this template and create an array like that. This is how far I have gotten:
Sub arrayTest()
Dim startDate As Long
Dim endDate As Long
Dim n As Long
Dim i As Long
Dim strN As String
Dim sl As SlicerItem
Dim strArr As Variant
Dim dur As Long
Dim result As String
endDate = Range("C17").Value ' endDate is the last SlicerItem to be selected
startDate = Range("G17").Value ' startDate is the first SlicerItem to be selected
dur = Range("C19").Value ' duration is the the number of SlicerItems to be selected
i = 0
ReDim strArr(dur) As Variant
With ActiveWorkbook.SlicerCaches("Slicer_YYYYWW")
' .ClearManualFilter
For n = startDate To endDate
strN = CStr(n) ' convert n to string
If n = 201753 Then ' this is needed for when the year changes
strN = CStr(201801)
n = 201801
End If
strArr(i) = """[Results].[YYYYWW].&[" & strN & "]""" ' write string into array
i = i + 1
' For Each sl In .SlicerCacheLevels(1).SlicerItems
' If sl.Name = strN Then
' sl.Selected = True
' Else
' sl.Selected = False ' this is read-only for OLAP data so it's not working
' End If
' Next
Next
MsgBox Join(strArr, ", ") ' the MsgBox returns the correct string to be applied to select the right slicer items
.VisibleSlicerItemsList = Join(strArr, ", ") ' Error 13: Type mismatch
End With
End Sub
Currently, the code gives Error 13: Type mismatch on .VisibleSlicerItemsList = Join(strArr, ", "), which is also commented. So I'm guessing that either dimensioning strArr as Variant is wrong, the data is not inserted correctly into strArr or it's just impossible to do it this way. In the case of the latest one, how should I do it?
The part commented out on lines 29-35 does not work as it gives the usual error of Application-defined or object-defined error (1004) on sl.Selected = False.
I had a similar issue to overcome. Which I resolved using the following code:
Sub show_SlicerItems()
Dim sc As SlicerCache
Dim sL As SlicerCacheLevel
Dim si As SlicerItem
Dim slicerItems_Array()
Dim i As Long
Application.ScreenUpdating = False
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Name")
Set sL = sc.SlicerCacheLevels(1)
ActiveWorkbook.SlicerCaches("Slicer_Name").ClearManualFilter
i = 0
For Each si In sL.SlicerItems
ReDim Preserve slicerItems_Array(i)
If si.Value <> 0 Then
slicerItems_Array(i) = si.Name
i = i + 1
End If
Next
sc.VisibleSlicerItemsList = Array(slicerItems_Array)
Application.ScreenUpdating = True
End Sub
You need to feed .VisibleSlicerItemsList an array, not a string. Ditch the Join.
And your strArr assignment should be like this: strArr(i) = "[Results].[YYYYWW].&[" & strN & "]" i.e. you don't need to pad it out with extra "
Edit: Out of interest, I happen to be building a commercial add-in that is effectively a Pop-up Slicer, that allows you to filter an OLAP PivotTable to show all items between a range like you are attempting to do. It also lets you filter on wildcards, crazy combinations of AND and OR, and filter on lists stored in external ranges.
Here's a screenshot of it in action. Note there is a search bar up the top that lets you use < or > together to set lower and upper limits, which is what I've done in the current Search. And you can see the result: it has correctly identified the 14 items from the PivotField that fit the bill.
All I need to do to filter the PivotTable on these is click the "Filter on selected items" option, and it does just that:
But working out how to do this - particularly given the limitations of the PivotTable object model (especially where OLAP PivotTables are concerned) was a VERY long term project, with many, many hurdles to overcome to make it work seamlessly. I can't share the code I'm afraid, as this is a commercial offering that I aim to release shortly. But I just wanted to highlight that while this is certainly possible, you are going to be biting off quite a bit if you want it to not throw errors when items don't exist.
Forget my other answer...you can use the Labels Filter to do this easily, provided the field of interest is in the PivotTable as either a Rows or Columns field. Fire up the Macro Recorder, and do the following:
...and you'll see that the PivotTable gets filtered:
...and the resulting code is pretty simple:
ActiveSheet.PivotTables("PivotTable1").PivotFields("[Table1].[YYYYWW].[YYYYWW]" _
).PivotFilters.Add2 Type:=xlCaptionIsBetween, Value1:="201726", Value2:= _
"201803"
Use this:
Sub seleciona_lojas()
Dim strArr()
Dim x As Long
Dim i As Long
For x = 2 To 262
ReDim Preserve strArr(i)
strArr(i) = "[Lojas].[Location_Cd].&[" & Planilha5.Range("B" & x).Value & "]"
i = i + 1
Next x
ActiveWorkbook.SlicerCaches("SegmentaçãodeDados_Location_Cd1").VisibleSlicerItemsList = strArr
End Sub

Using an array to filter Pivot Field

I'm trying to filter a pivot field to values held within an array using some nested for each loops. The pivot field I'm trying to filter contains accounting periods - the ones I want to keep visible are held in a range of cells on separate sheet - Date Control Sheet. The code I have is as below:
Sub updateMSFPivotCharts()
Dim PivotYear As String, PvtTable As PivotTable, PivotPeriodsRange As Range, DateLastRow As String, PivotPeriods As Variant, ReportPeriodPF As PivotField, YearPF As PivotField, Pi As PivotItem
Dim LboundReportPeriodPF As String, PivotPeriodItem As Variant
PivotYear = Worksheets("Date Control Sheet").Range("A2").Value
DateLastRow = Worksheets("Date Control Sheet").Range("B2").End(xlDown).Row
Set PivotPeriodsRange = Worksheets("Date Control Sheet").Range("B2:B" & DateLastRow)
PivotPeriods = PivotPeriodsRange.Value
'Update Topline Performance Pivot
Call AdjustPivotDataRange("MSF Topline Performance", "1", "A9", "BI", strLastRow)
Set PvtTable = Worksheets("MSF Topline Performance").PivotTables("PivotTable1")
Set YearPF = Worksheets("MSF Topline Performance").PivotTables("PivotTable1").PivotFields("Year")
Set ReportPeriodPF = Worksheets("MSF Topline Performance").PivotTables("PivotTable1").PivotFields("Report Period")
'Filter Pivot to Date Ranges expressed on Date Control Sheet
With PvtTable
'Update Pivot Table Field Filtering
YearPF.ClearAllFilters
ReportPeriodPF.ClearAllFilters
YearPF.CurrentPage = PivotYear
End With
With ReportPeriodPF
For Each PivotPeriodItem In PivotPeriods
For Each Pi In ReportPeriodPF.PivotItems
If Pi = PivotPeriodItem Then GoTo Skipstep Else Pi.Visible = False
Next Pi
Skipstep:
Pi.Visible = True
Next PivotPeriodItem
End With
The problem I have, is that when I match Pi to PivotPeriodItem and exit out of the loop, Pi starts back at the beginning with PivotPeriodItem moving onto the next Item, hence when Pi is equal to the previous PivotPeriodItem, it then hides it again, when I want it to show.
Does anyone have any suggestion on how I can re-write the code to get by this problem? Many thanks for any help provided in advance.
Andrew
Instead of
With ReportPeriodPF
For Each PivotPeriodItem In PivotPeriods
For Each Pi In ReportPeriodPF.PivotItems
If Pi = PivotPeriodItem Then GoTo Skipstep Else Pi.Visible = False
Next Pi
Skipstep:
Pi.Visible = True
Next PivotPeriodItem
End With
Replace it with
With ReportPeriodPF
For Each Pi In ReportPeriodPF.PivotItems
If WorksheetFunction.CountIf(PivotPeriodsRange, Pi) > 0 Then
Pi.Visible = True
Else
Pi.Visible = False
End If
Next Pi
End With
One loop, just using CountIf to test against a range instead of individual items in the range.

Excel VBA - Return selected element in slicer

I have a slicer called 'Slicer_HeaderTitle'. I simply need to be able to dim a variable in VBA with the value of the selected element. I'll only have one element selected at a time.
I've had a lot of problems with selecting and de-selecting elements from my slicer dynamically via VBA, since my pivot table is connected to an external data-source. I don't know if this is relevant for this exact example, but this table is connected to the same external data-source.
I used to have a single line of code, which could return this value, but all i could find now requires you loop through each element in the slicer and check if it's selected or not. I hope to avoid this, since I only have 1 selected element at a time.
' This is what I'm trying to achieve.
Dim sValue as String
sValue = ActiveWorkbook.SlicerCaches("Slicer_HeaderTitle").VisibleSlicerItems.Value
msgbox(sValue)
'Returns: "Uge 14 - 2016 (3. Apr - 9. Apr)"
Current Status:
This is what i did:
Public Function GetSelectedSlicerItems(SlicerName As String) As String
Dim SL As SlicerCacheLevel
Dim sI As SlicerItem
Set SL = ActiveWorkbook.SlicerCaches(SlicerName).SlicerCacheLevels(1)
For Each sI In SL.SlicerItems
If sI.Selected = True Then
GetSelectedSlicerItems = (sI.Value)
End If
Next
End Function
Dim sValue As String
sValue = GetSelectedSlicerItems("Slicer_HeaderTitle")
Thanks to Doktor OSwaldo for helping me a lot!
Ok to find the error, we will take a step back, delete my function and try Looping through the items:
Dim sC As SlicerCache
Dim SL As SlicerCacheLevel
Dim sI As SlicerItem
Set sC = ActiveWorkbook.SlicerCaches("Slicer_Dates_Hie")
Set SL = sC.SlicerCacheLevels(1)
For Each sI In SL.SlicerItems
sC.VisibleSlicerItemsList = Array(sI.Name)
Next
I would like to put in my two cents. The set of visible slicer items may be shrunk by both independent actions:
User selection of items in slicer A. To capture those items, use .Selected method.
Selection of items in slicer B which in consequence shrinks the list of slicer A items. To capture those items, use .HasData method.
Note that you may see only say two items of Slicer_Products (apples, bananas) because some other slicer Slicer_Product_Type has active filter on fruits. The method sI.Selected would still return the whole list of products apples, bananas, carrots...
If you want both limitations to be in place then make intersection of both sets. I have modified TobiasKnudsen code (excellent answer!) to return the list of items shrunk by both above limitations. If sI.Selected = True And sI.HasData = True Then is the key line in this code.
Option Explicit
Sub TestExample()
Dim MyArr() As Variant
MyArr = ArrayListOfSelectedAndVisibleSlicerItems("Slicer_A")
'now variable MyArr keeps all items in an array
End Sub
Public Function ArrayListOfSelectedAndVisibleSlicerItems(MySlicerName As String) As Variant
'This function returns an array of the limited set of items in Slicer A
'Limitation is due to both:
'(1) direct selection of items by user in slicer A
'(2) selection of items in slicer B which in consequence limits the number of items in slicer A
Dim ShortList() As Variant
Dim i As Integer: i = 0 'for iterate
Dim sC As SlicerCache
Dim sI As SlicerItem 'for iterate
Set sC = ThisWorkbook.Application.ActiveWorkbook.SlicerCaches(MySlicerName)
For Each sI In sC.SlicerItems
If sI.Selected = True And sI.HasData = True Then 'Here is the condition!!!
'Debug.Print sI.Name
ReDim Preserve ShortList(i)
ShortList(i) = sI.Value
i = i + 1
End If
Next sI
ArrayListOfSelectedAndVisibleSlicerItems = ShortList
End Function
Sub Demo()
Dim i As Integer
With ActiveWorkbook.SlicerCaches("Slicer_Country")
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected Then
Sheets("Pivot Sheet").Range("I" & i) = SlicerSelections & " " & .SlicerItems(i).Value
End If
Next i
End With
End sub
This is how I managed to identify the selected element on a slicer.
The answer by TobiasKnudsen above did not work for me as I got an error stating the data source needed to be an OLAP source.
My data is an excel table and this is the code that worked:
Dim val as Boolean
val = ThisWorkbook.SlicerCaches("Slicer_MYSLICER").VisibleSlicerItems.Item("CS").HasData
In my case, the slicer had only 3 items so I repeated the line above with a different string in item()
So, where val was true, that was the item that was currently selected.

Excel VBA for pivot Value using xlValueIsBetween

I am trying to create a module to share functionality across a number of worksheets within a single workbook. All works fine apart from some filter code.
The code below works fine if I place it in a single worksheet
ActiveSheet.PivotTables("PivotTable1").PivotFields("MyField"). _
ClearValueFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("MyField").PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables _
("PivotTable1").PivotFields("MyValue"), Value1:=bottom, Value2:=Top
However, I want to use this code in my Module and send it the following: Pivot Table Name, Row PivotField, Value Pivot fieldtop "between" valuebottom "between" value
Something like:
The sheet call
Call Mod_Filter("PivotTable1", "MyRowFieldName", "MyValueFieldName", 0, intvalue)
The Module code
Public Sub Mod_Filter(ByRef PT_Name As String, ByRef StaticField As String, ByRef Filter_field As String, bottom As Double, Top As Double)
ActiveSheet.PivotTables(PT_Name).PivotFields(StaticField).ClearValueFilters
ActiveSheet.PivotTables(PT_Name).PivotFields(StaticField).PivotFilters.Add Type:=xlValueIsBetween, DataField:=ActiveSheet.PivotTables _
(PT_Name).PivotFields(Filter_field), Value1:=bottom, Value2:=Top
End Sub
However, I cannot get this to work. Any suggestions??
So I'm using the "St" Row to filter the YTD% based on a value selected from a dropdown combo box
Requirement:
To filter a Pivot RowField based on a Pivot DataField
This procedure uses the PivotField.SourceName to validate & set the DataField to apply the Filter Type and Values.
Sub Ptb_Filter_Between(WshTrg As Worksheet, _
sFldTrg As String, sFldDta As String, dFromVal As Double, dToValue As Double)
Dim pTbl As PivotTable, pFldDta As PivotField
Rem Application Settings - OFF
Application.ScreenUpdating = False
Application.EnableEvents = False
Rem Set PivotTable
'Using Index 1 as OP confirmed there is only one PivotTable per Sheet
'If this condition change then PivotTable Index should be provided as an argument
Set pTbl = ActiveSheet.PivotTables(1)
With pTbl
Rem Set DataField - User provides the Data Field
For Each pFldDta In .DataFields
If pFldDta.SourceName = sFldDta Then Exit For
Next
If pFldDta Is Nothing Then GoTo ExitTkn
Rem Filter PivotField
.ClearAllFilters 'Use this line to clear all PivotTable Filters
On Error GoTo ExitTkn
With .PivotFields(sFldTrg)
.ClearAllFilters 'This line clears all PivotField Filters
.PivotFilters.Add2 Type:=xlValueIsBetween, _
DataField:=pFldDta, Value1:=dFromVal, Value2:=dToValue
End With: End With
ExitTkn:
Rem Application Settings - ON
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
These are some samples of how to call the procedure:
sFldTrg = "Type"
sFldDta = "Amount"
dFromVal = 25000
dToValue = 30000
Call Ptb_Filter_Between(Worksheet Object, sFldTrg, sFldDta, dFromVal, dToValue)
sFldTrg = "Type"
sFldDta = "YTD%"
dFromVal = 0.3
dToValue = 0.35
Call Ptb_Filter_Between(Worksheet Object, sFldTrg, sFldDta, dFromVal, dToValue)
sFldTrg = "Row"
sFldDta = "YTD%"
dFromVal = 0.1 'To set from value as 10%
dToValue = 0.2 'To set to value as 20%
Call Ptb_Filter_Between(Worksheet Object, sFldTrg, sFldDta, dFromVal, dToValue)

Excel VBA PivotTable ShowDetails

I have a pivot table that contains a number of Expand/Collapse buttons related to Customer, Year, and Quarters all of which have vba behind them to .Showdetails as appropriate. These individual sets of code work. However, I'm trying to make my code more efficient, and manageable, and thanks to another user, I'm getting closer.
Here's the code for each button that works:
Sub Expand_Quarter()
Range("R13").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Quarter").ShowDetail = IIf(Selection.ShowDetail, False, True)
End Sub
And Here is the code that is throwing an error. I've commented where the error occurs:
Sub ExpColl()
Dim pt As PivotTable, pf As PivotField, b As String
b = Application.Caller
With ActiveSheet
Set pt = .PivotTables("PivotTable1")
Select Case b
Case "btnExpCollCustProd": Set pf = pt.PivotFields(.Range("Q15").PivotField.Name)
Case "btnExpCollYear": Set pf = pt.PivotFields(.Range("R12").PivotField.Name)
Case "btnExpCollQtr": Set pf = pt.PivotFields(.Range("R13").PivotField.Name)
End Select
'--- Run Time Error 1004 Application-defined or Object Defined Error"
pf.ShowDetail = IIf(pf.ShowDetail, False, True)
End With
End Sub
The variable pf does return exactly what I expect, so I'm a little perplexed. All help greatly appreciated.
I worked it out!!! The following code will work exactly how I want it to:
Sub ExpColl()
Dim pt As PivotTable, pf As PivotField, b As String, s As Shape, bev As Long, r As Range
b = Application.Caller
Set s = ActiveSheet.Shapes(b)
If b Like "btnExpColl*" Then
With ActiveSheet
Set pt = .PivotTables("PivotTable1")
Select Case b
Case "btnExpCollCustProd":
Set r = .Range("Q15")
Set pf = pt.PivotFields(r.PivotField.Name)
Case "btnExpCollYear":
Set r = .Range("R12")
Set pf = pt.PivotFields(r.PivotField.Name)
Case "btnExpCollQtr":
Set r = .Range("R13")
Set pf = pt.PivotFields(r.PivotField.Name)
End Select
pf.ShowDetail = IIf(r.ShowDetail, False, True)
s.ThreeD.BevelTopType = IIf(s.ThreeD.BevelTopType = 3, 7, 3)
End With
End If
End Sub
I hope this helps someone else out there :)
I assume this problem might be related to the fact that each value of the field might have different value of ShowDetail property, so Excel does not even try to return it even if all the values were identical.
One way to avoid hardcoding specific ranges (which depends on the physical layout of the pivot table) is to use the following code:
pf.ShowDetail = Not pf.DataRange.Cells(1).ShowDetail