VBA to expand & collapse mutiple pivot tables at the same time

[jrg729]

Hi, I have some VBA that allows for expanding or collapsing multiple pivot tables of similar structure, controlling the expand/collapse from just one of the pivot tables. The code works great one pivot item at a time, but fails when attempting to Expand Entire Field or Collapse Entire Pivot Field. My novice attempts at adjusting the code to include the Expand/Collapse Entire Field options have failed... hoping someone can help. I've included the code below, and I'm running Excel 2010.

Thanks in advance.
-jrg729

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
    Dim ptItem As PivotItem
    Dim ptField As PivotField
    Dim pt As PivotTable
    Dim ws As Worksheet
    Dim strField As String
   
    On Error Resume Next
    Set ptItem = ActiveCell.PivotItem
    On Error GoTo Oops
   
    If Not ptItem Is Nothing Then
        Set ptField = ptItem.Parent
        With ptField
            If .Orientation = xlColumnField Or .Orientation = xlRowField Then
                With Application
                    .ScreenUpdating = False
                    .EnableEvents = False
                End With
                strField = .Name
               On Error Resume Next
                For Each ws In ActiveWorkbook.Worksheets
                    For Each pt In ws.PivotTables
                        If Not pt.TableRange1.Address(external:=True) = _
                                Target.TableRange1.Address(external:=True) Then
                            pt.PivotFields(strField).PivotItems(ptItem.Caption).ShowDetail = ptItem.ShowDetail
                        End If
                    Next pt
                Next ws
                On Error GoTo Oops
            End If
        End With
    End If
   
clean_up:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Exit Sub
   
Oops:
    MsgBox Err.Description
    Resume clean_up

End Sub