How to collapse pivot items that only have one sub-item with VBA?

I have a data source that has multiple outline levels. Here is an example:

Level 1 | Level 2 | Level 3
A        1          X1
A        1          X2
A        2          X3
B        3          X4
B        4          X5
B        4          X5
C        5          X6
C        5          X6
C        5          X6

When I pivot it, all 3 fields are row labels, like this:

What I want is to collapse the items that have only one item under them. I can easily do it manually, with a result like this:

I know how to loop through the pivot tables and pivot fields. I can for example, make it collapse all of them, with this code:

Sub CollapseAllPivotItems()

    With ActiveSheet.PivotTables(1)
        For Each pf In .PivotFields
            If pf.Orientation = xlRowField Then
                For Each Pi In pf.PivotItems
                    ' Need the IF condition to go here
                       Pi.ShowDetail = False
                Next Pi
            End If
        Next pf
    End With
End Sub

But I can't find an appropriate property of the PivotItem class that I can use for the conditional as to when I should or should not collapse them.

I would do it programatically the same way as I would do it manually.

At first look at Level 1. Go through all rows in Pivot Table's row range. And if there is a Level 1 entry only followed by one Level 2 entry and then only by one Level 3 entry. So the entry 3 lines after is Level 1 again or the end of the Pivot Table's row range, then do not show details of that Level 1 entry.

Then same for Level 2. If there is a Level 2 entry only followed by one Level 3 entry. So the entry 2 lines after is Level 2 again or Level 1 or the end of the Pivot Table's row range, then do not show details of that Level 2 entry.

In general for n levels: if there is a Level k entry only followed by one Level (k+1) entry and then only by one Level (k+2) entry and then only by one Level (k+3) entry ... and then only by one Level (n) entry. So the entry (n-k+1)) lines after is Level k again or Level (k-1) or Level (k-2) ... or Level (1) or the end of the Pivot Table's row range, then do not show details of that Level k entry.

But what if a a Level k entry has more than one Level (k+1) entry one time but then another time it has only one Level (k+1) entry? Then it also should show the details because of it has one time more than one Level (k+1) entry.

So I will collect the Level entries, together with the decision whether showing details or not, in a dictionary. Then I go through that dictionary to implement the decisions.

Option Explicit

Sub hideDetailPivotItems()
 Dim oPT As PivotTable
 Dim oPF As PivotField, oPFSibling As PivotField
 Dim oPRow  As Range, oPRowSibling As Range
 Dim oPI As PivotItem
 Dim sPIName As Variant
 Dim i As Long, k As Long, s As Long, lCountRowPFs As Long
 Dim bShowDetail  As Boolean
 Dim dPIShowDetail As Object

 Set oPT = ActiveSheet.PivotTables("PivotTable1")

 Dim aRowPFs() As String

 i = 0
 For Each oPF In oPT.RowFields
  ReDim Preserve aRowPFs(i)
  aRowPFs(i) = oPF.Name
  i = i + 1

  On Error Resume Next
  oPF.ShowDetail = True
  On Error GoTo 0

 Next

 lCountRowPFs = UBound(aRowPFs)
 For k = 0 To lCountRowPFs - 1

  Set dPIShowDetail = CreateObject("Scripting.Dictionary")

  For i = 1 To oPT.RowRange.Count

   Set oPRow = oPT.RowRange.Item(i)

   Set oPF = Nothing
   On Error Resume Next
   Set oPF = oPRow.PivotField
   On Error GoTo 0
   If Not oPF Is Nothing Then

    If oPF.Name = aRowPFs(k) Then

     Set oPI = Nothing
     On Error Resume Next
     Set oPI = oPRow.PivotItem
     On Error GoTo 0
     If Not oPI Is Nothing Then

      Set oPRowSibling = Nothing
      Set oPFSibling = Nothing
      On Error Resume Next
      Set oPRowSibling = oPT.RowRange.Item(i + (lCountRowPFs - k + 1))
      Set oPFSibling = oPRowSibling.PivotField
      On Error GoTo 0

      bShowDetail = True
      If oPRowSibling Is Nothing Then
       bShowDetail = False
      ElseIf oPFSibling Is Nothing Then
       bShowDetail = False
      Else
       For s = k To 0 Step -1
        If oPFSibling.Name = aRowPFs(s) Then
         bShowDetail = False
        End If
       Next
      End If

      If dPIShowDetail.exists(oPI.Name) Then
       If bShowDetail Then dPIShowDetail(oPI.Name) = bShowDetail
      Else
       dPIShowDetail.Add oPI.Name, bShowDetail
      End If
     End If
    End If
   End If
  Next

  For Each sPIName In dPIShowDetail.keys
   oPT.PivotFields(aRowPFs(k)).PivotItems(sPIName).ShowDetail = dPIShowDetail(sPIName)
  Next

 Next

End Sub