Enumerate subgroups pivottable vba

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

  1. Set these PivotTable properties:
     RowGrand, ColumnGrand, MergeLabels, RowAxisLayout

  2. Set these properties for the ColumnFields:
     Orientation

  3. Set these properties for the RowFields:
     RepeatLabels, Subtotals

  4. 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.