Pivot Table Page Fields: Need a UDF to display selected items instead of just "(Multiple Items)"

All Replies

• Friday, November 19, 2010 5:50 PM

   

   
  

  0

  More info on this topic - I ended up creating two macros that go through Pivot Table Page fields.  One shows what is visible, the other shows what is hidden:

  Any suggestions on how I can turn these Macros in to Functions would be most appreciated.

  Sub PivotListFilteredPageFilters() ' Hidden Items Property really doesn't work - need to do this "kludge"
  Dim oAppCalc: oAppCalc = Application.Calculation: Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False: Application.EnableEvents = False
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim ac As String: ac = ActiveCell.Address
    Dim pvt As PivotTable: Dim pf As PivotField: Dim pi As PivotItem
    Dim pf_index As Byte: Dim H_Count, V_Count As Byte: Dim pvt_Count: pvt_Count = 0
    Dim OldPage As String: Dim Hidden As String: Hidden = "": Dim Visible As String: Visible = ""
    Dim Start_of_Page_Fields
  ac = ActiveCell.Address
  Range("A1").Select
  With ws
    For Each pvt In ws.PivotTables
    pvt.PivotSelect "", xlDataAndLabel, True
  Start_of_Page_Fields = ActiveCell.Address
  ActiveCell.Offset(0, 2).Select
    pvt_Count = pvt_Count + 1
      pf_index = 0
      Count_of_Pfs = pvt.PageFields.Count
      For Each pf In pvt.PageFields
        H_Count = 0: V_Count = 0
        pf_index = pf_index + 1
        OldPage = pf.CurrentPage
        For Each pi In pvt.PageFields(pf_index).PivotItems
          On Error Resume Next
          pf.CurrentPage = pi.Name
          If Err = 0 Then ' Visible
          V_Count = V_Count + 1
          Visible = Visible & " = " & pi.Name
          End If
          If Err <> 0 Then ' Hidden
          H_Count = H_Count + 1
          Hidden = Hidden & " = " & pi.Name
          End If
        Next pi
        For pvt_Count = 0 To Count_of_Pfs
          If pf.Name = Range(Start_of_Page_Fields).Offset(pvt_Count, 0) Then
            If V_Count = 0 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Font.ColorIndex = 0
            If V_Count > 0 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Value = H_Count & " hid - " & V_Count & " vis: " & Visible
            If V_Count > 0 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Font.ColorIndex = 3
          End If
        Next pvt_Count
        Hidden = "": H_Count = 0: Visible = "": V_Count = 0: pvt_Count = 0: pf.CurrentPage = OldPage
      Next pf
       For Each pf In pvt.PageFields ' Go back through and only show values if PageField value is (Multiple Items)
        For pvt_Count = 0 To Count_of_Pfs
          If pf.Name = Range(Start_of_Page_Fields).Offset(pvt_Count, 0) Then
          sString = ActiveCell.Offset(pvt_Count, -1).Value
            If ActiveCell.Offset(pvt_Count, -1).Value <> "(Multiple Items)" Then
              ActiveCell.Offset(pvt_Count, 0).Range("A1").Font.ColorIndex = 0
              ActiveCell.Offset(pvt_Count, 0).Range("A1").Value = "<---"
            End If
          End If
        Next pvt_Count
       Next pf
    Next pvt
  End With
  Exit_Out:
  Range(ac).Select
  Set wb = Nothing: Set ws = Nothing: Set pvt = Nothing: Set pf = Nothing: Set pi = Nothing
  Application.Calculation = oAppCalc: Application.ScreenUpdating = True: Application.EnableEvents = True
  End Sub

  Sub PivotListHiddenPageFilters() ' Hidden Items Property really doesn't work - need to do this "kludge"
  Dim oAppCalc: oAppCalc = Application.Calculation: Application.Calculation = xlCalculationManual: Application.ScreenUpdating = False: Application.EnableEvents = False
    Dim wb As Workbook: Set wb = ActiveWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim ac As String: ac = ActiveCell.Address
    Dim pvt As PivotTable: Dim pf As PivotField: Dim pi As PivotItem
    Dim pf_index As Byte: Dim H_Count As Byte: Dim pvt_Count: pvt_Count = 0
    Dim OldPage As String: Dim Hidden As String: Hidden = ""
    Dim Start_of_Page_Fields
  ac = ActiveCell.Address
  Range("A1").Select
  With ws
    For Each pvt In ws.PivotTables
    pvt.PivotSelect "", xlDataAndLabel, True
  Start_of_Page_Fields = ActiveCell.Address
  ActiveCell.Offset(0, 2).Select
    pvt_Count = pvt_Count + 1
      pf_index = 0
      Count_of_Pfs = pvt.PageFields.Count
      For Each pf In pvt.PageFields
        H_Count = 0
        pf_index = pf_index + 1
        OldPage = pf.CurrentPage
        For Each pi In pvt.PageFields(pf_index).PivotItems
          On Error Resume Next
          pf.CurrentPage = pi.Name
          If Err <> 0 Then
          H_Count = H_Count + 1
          Hidden = Hidden & " = " & pi.Name
          End If
        Next pi
        For pvt_Count = 0 To Count_of_Pfs
          If pf.Name = Range(Start_of_Page_Fields).Offset(pvt_Count, 0) Then
            If H_Count = 1 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Value = H_Count & " hid val in " & pf.Name & " : " & Hidden
            If H_Count <> 1 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Value = H_Count & " hid vals in " & pf.Name & " : " & Hidden
            If H_Count = 0 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Font.ColorIndex = 0
            If H_Count > 0 Then ActiveCell.Offset(pvt_Count, 0).Range("A1").Font.ColorIndex = 3
          End If
        Next pvt_Count
        Hidden = "": H_Count = 0: pvt_Count = 0: pf.CurrentPage = OldPage
      Next pf
    Next pvt
  End With
  Exit_Out:
  Range(ac).Select
  Set wb = Nothing: Set ws = Nothing: Set pvt = Nothing: Set pf = Nothing: Set pi = Nothing
  Application.Calculation = oAppCalc: Application.ScreenUpdating = True: Application.EnableEvents = True
  End Sub

  Thanks,

  Lou Sigety

  ---

  Lou Sigety
  • Reply
  • Quote