Collapse pivot table detail for prior years

I have a workbook with about 120 tabs, each containing one or two pivot tables.

The pivot tables are updated and refreshed monthly.

I am struggling to collapse all prior year data.

This code works, but I need to update and re-run it for each prior year:

Dim ws As Worksheet
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems("2015"). _
            ShowDetail = False
        On Error Resume Next
        ws.PivotTables("PivotTable2").PivotFields("Years").PivotItems("2015"). _
            ShowDetail = False
    End If
Next ws
End Sub

I would prefer code that can collapse all prior year data.

I tried the following, and it produces a

run-time error 438 object doesn't support this property or method:

Dim ws As Worksheet
Dim datecell As Range
Dim cy As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        'the following line produces the 
        ' run-time 438 object doesn't support this property or method error
        If Year(ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems) < cy Then
            PivotItem.ShowDetails = False
        End If
    End If
Next ws
End Sub

I also tried the following, and it produces a

run-time error 13 type mismatch:

Dim ws As Worksheet
Dim datecell As Range
Dim cy As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        For Each PivotItem In ws.PivotTables("PivotTable1").PivotFields("Years").PivotItems
            'the following line produces the run-time 13 type mismatch error
            If Year(PivotItem) < cy Then
                PivotItem.ShowDetails = False
            End If
        Next PivotItem
    End If
Next ws
End Sub

How do I correct my code?

Edit 1: The following code produces a

run-time error 438: Object doesn't support this property or method:

Dim ws As Worksheet
Dim pt As PivotTable
Dim ptItm As PivotItem
Dim datecell As Range
Dim cy As Long
Dim ptItmY As Long

Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        For Each pt In ws.PivotTables
            For Each ptItm In pt.PivotFields("Years").PivotItems
                ptItmY = Right(ptItm, 4)
                If ptItmY < cy Then
                    'the following line produces
                    ' run-time error 438: Object doesn't support this property or method
                    ptItm.ShowDetails = False
                    Else: ptItm.ShowDetails = True
                End If
            Next ptItm
        Next pt
    End If
Next ws
End Sub

Uploaded image of a pivot table:

Thank you for helping me work this out, Shai Rado. It turns out the last code I asked about would have worked if I had used ShowDetail instead of ShowDetails. I guess it is all in the details. :)

For anyone else who might want a macro that collapses all prior year details in multiple pivot tables across multiple worksheets, this is my final code:

Sub CollapsePYDetail()
'
' Colapse prior year detail
'
Dim ws As Worksheet
Dim pt As PivotTable
Dim ptItm As PivotItem
Dim datecell As Range
Dim cy As Long
Dim ptItmY As Long

'Turn off screen updating
Application.ScreenUpdating = False

'Change calculation option to manual
Application.Calculation = xlManual

'Make the status bar visible
Application.DisplayStatusBar = True

'Set the location where the cutoff date is stored (update the worksheet name and cell for your use)
Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = Year(datecell)

For Each ws In ThisWorkbook.Worksheets

    'Show the progress in the statusbar:
    Application.StatusBar = "Collapsing prior year detail on tab " & ws.Name

    'Loop through worksheets with pivot tables (update with your worksheet name criteria, or eliminate this if statement if you want to loop through all worksheets) 
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then
        'Loop through each pivot table on the worksheet
        For Each pt In ws.PivotTables
            'Loop through each item in the Years field, collapsing everything not in the current year
            For Each ptItm In pt.PivotFields("Years").PivotItems
                ptItmY = Right(ptItm, 4)
                If ptItmY = cy Then
                    ptItm.ShowDetail = True
                    'Use "on error to resume next" to prevent an error where the detail is already collapsed
                    On Error Resume Next
                    Else: ptItm.ShowDetail = False
                End If
            Next ptItm
        Next pt
    End If
Next ws

'Notify user the process has finished
MsgBox "Prior year detail has been collapsed for all tabs."

'Reset the statusbar:
Application.StatusBar = False

'Return calculation option to automatic
Application.Calculation = xlAutomatic

'Turn on screen updating
Application.ScreenUpdating = True

End Sub

Sub CollapsePYDetail() ' ' Colapse prior year detail ' Dim ws As Worksheet Dim pt As PivotTable Dim ptItm As PivotItem Dim datecell As Range Dim cy As Long Dim ptItmY As Long 'Turn off screen updating Application.ScreenUpdating = False 'Change calculation option to manual Application.Calculation = xlManual 'Make the status bar visible Application.DisplayStatusBar = True 'Set the location where the cutoff date is stored (update the worksheet name and cell for your use) Set datecell

As long as Range(H1).value is a date (cy is a number), then the code below colapses all Years < cy :

Option Explicit

Sub Collapse_Pivot_PrevYears()

Dim ws                  As Worksheet
Dim datecell            As Range
Dim cy                  As Long
Dim pvtFld              As PivotField
Dim pvtitem             As PivotItem
Dim pvtTbl              As PivotTable


Application.ScreenUpdating = False

Set datecell = ThisWorkbook.Worksheets("Index").Range("H1")
cy = year(datecell)

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "1" & "*" Or ws.Name Like "2" & "*" Or ws.Name Like "3" & "*" Then

        Set pvtTbl = ws.PivotTables("PivotTable1")

        ' set Pivot field variable to "Years"
        Set pvtFld = ws.PivotTables("PivotTable1").PivotFields("Years")

        For Each pvtitem In pvtFld.PivotItems
            Dim pvtYear         As Long

            ' added: manipulation of Date formats in different types of strings
            Select Case Len(pvtitem.Name)
                Case 4   ' date in format of "2011" , "2012"
                    pvtYear = CLng(pvtitem.Value)

                Case 11  ' date in format of "<01/01/2010"
                    pvtYear = year(CDate(Mid(pvtitem.Value, 2)))

                Case Else ' if you will have any other date formats in the future

            End Select

            If pvtYear < cy Then
                pvtFld.PivotItems(CStr(pvtYear)).ShowDetail = False
            Else
                pvtitem.ShowDetail = True
            End If



        Next pvtitem

    End If
Next ws

End Sub

Just select cell in the field, and use the buttons on the ribbon. These buttons are called Expand entire field, and Collapse entire field. The same options are available in the right-click menu. Use Expand entire field, and Collapse Entire field under the expand/collapse menu. We can use the same approach for column label fields. If we select an item in the Year grouping, we can expand and collapse all quarters at once. We can also work with each year individually by double-clicking. You can

OP has clearly resolved issue, but I will post how I did it with my code to perhaps help future readers who end up on this page.

This is how I create the PivotField:

With PSheet.PivotTables("PivotTable").PivotFields("Date")
 .Orientation = xlRowField
 .Position = 1
 .DataRange.Cells(1).Group Periods:=Array(False, False, False, True, True, False, True)
 'Seconds-->Minutes-->Hours-->Days-->Months-->Quarters-->Years
End With

This is how I expand/collapse it to desired level:

With PSheet.PivotTables("PivotTable")
 .PivotFields("Years").ShowDetail = False
 .PivotFields("Months").ShowDetail = False
 .PivotFields("Years").PivotItems(Format(Now(), "yyyy")).DrillTo "Months"
End With

If the pivot table is currently collapsed to years, the “Expand_Entire_RowField” macro will expand ALL of the Year items to display the Quarters for each year. Running the “Collapse_Entire_RowField” macro will collapse the Year items back. You can download the file that contains the macros below.

Excel PivotTables are a treasure trove of features. One of my favourites is the ability to expand/collapse and drill down into the data. Let’s look at an example; the first column of the PivotTable below lists Categories, which group and summarise Products.

In this dialog box you can choose the field containing the detail you want to show, and that field will be added to the Pivot Table report which detail will show for the respective inner row or column items. Example - how Expand and Collapse works: Refer Image 1a - Pivot Table report shows details for all fields and items.

Select a cell in the pivot table. On the Ribbon, under PivotTable Tools tab, click the Analyze tab; Click the +/- Buttons command, to toggle the buttons on or off Expand or Collapse a Specific Pivot Item. You can expand or collapse a specific item in a pivot field, and see only its heading.

Comments
  • Try "If Year(PivotItem.Value)".
  • @Qqqqq try the code in my answer below
  • @Mats Lind .value didn't work because Excel added less than and greater than values so not all values in the year field are formatted with 2015, 2016, etc. formats.
  • Since you took 99% of my code, please mark my answer as "answer"
  • @Shai Rado You did help me with fine-tuning my code, and I am very appreciative of your input. I ended up using the final code I posted back here on Aug 17, and didn't see your Aug 18 edits until today. I would love to mark your answer as "answer", but I've never tried the code in your final post. I did mark your answer useful, but it doesn't show 'cause I don't have status.
  • assumption 2 doesn't hold true, as excel adds a <1/1/2010 and >8/1/2016 value to the Years field. I tried updating my code and now I'm getting a new error. I edited my question to reflect current code. Any further suggestions would be appreciated!
  • @Qqqqq buy now you have changed your post code, and half of the responses are not relevant, usually we don't do it on SO. In what format do you get the "Years" field ?
  • @Qqqqq try edited code (if your "Years" is formatted as "dd/dd/yyyy")
  • Sorry about changing the original post. I'm brand new here, and got a little confused about the best way to show updated code. I have put the original post back as it was, and now the new code is shown as Edit 1.
  • Can u upload a screen shot of one of your Pivot tables? I want to see how the fields and the data looks like (I can't simulate your error with my data)