PVT Blank Row height issue

[Cantonalives]

Hi all,
I am trying to decrease the height of the blank rows between items on a Pivot Table. The attached works but when fields are expanded, some items that are not blank, are formatted as if they were. My assumption is because the rows were blank and the expansion of the field is not recognising that fact.

Is there a VBA function that would rerun the code whenever a field is expanded? At present code runs on a PVT refresh only.

Sub rowheight()
Application.ScreenUpdating = False
    Dim hgt As Variant
    Dim WorkRng As Range
    xTxt = ActiveWindow.RangeSelection.Address
    Set WorkRng = Range("$b$16:$b$500")
For Each H In WorkRng
        If H.Value = "" Then
            hgt = H.Value
            H.EntireRow.Select
            Selection.rowheight = 2
        End If
    Next H
End Sub

Any help, much appreciated.

Thanks,

-CL

 

[p45cal]

There is an event which is triggered when expanding/collapsing:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
MsgBox "triggered"
End Sub

It's in the code module of the sheet that the pivot table is on. In addition, the Target is the pivot table, so you'll be able to use ranges derived from the pivot table itself. The following is a complete guess and probably won't work because it's dependent on the design and layout of the pivot table (as well as it trying to work on any pivot on the same sheet), but something along the lines of:

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
For Each cll In Target.RowRange.Cells
  If cll = "" Then cll.RowHeight = 5 Else cll.RowHeight = 15
Next cll
End Sub

To get a better answer attach a workbook with a bit more detail about what you want and where.