Search code examples
vbaexcelpivot-tabledrilldown

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.


Solution

  • 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 :)