Navigate Pivot Table Row Structure

[abbeyWigan]

Does anyone know how best to navigate a pivot table sideways (i.e. on same row but from column to column) using VBA?

If I pick any pivot item in the pivot table, I can find its parent item or column heading within the same column by simply doing

Set obj = pivotItem.Paent

However, I've been pulling my hair out trying to find a function or method that will allow me to navigate sideways, i.e. return the corresponding value (or range object) at the same level from another column.

pivotItem.DrillTo()

seems to be a natural candidate but I can't get it to work. GetPivotData doesn't seem to work for me either. I'm having a really bad day on this.

My pivot table is formatted to in tabular mode with column headings and collapsible rows. All I want to do is be able to pick any sub pivot item and get its left-most parent on the same row.

 

[Worf]

Hi

Sub Sideways()
Dim pt As PivotTable, pi As PivotItem, pia$
Set pt = ActiveSheet.PivotTables("pivottable4")
Set pi = pt.PivotFields("values").PivotItems(2)                 ' desired pivot item
pia = pi.DataRange.Cells(1, 1).Row                              ' desired row
MsgBox Cells(pia, pt.DataBodyRange.Columns(1).Column)
MsgBox Cells(pia, pt.RowRange.Columns(1).Column)
End Sub

 

[abbeyWigan]

Hi

Sub Sideways()
Dim pt As PivotTable, pi As PivotItem, pia$
Set pt = ActiveSheet.PivotTables("pivottable4")
Set pi = pt.PivotFields("values").PivotItems(2)                 ' desired pivot item
pia = pi.DataRange.Cells(1, 1).Row                              ' desired row
MsgBox Cells(pia, pt.DataBodyRange.Columns(1).Column)
MsgBox Cells(pia, pt.RowRange.Columns(1).Column)
End Sub

Many thanks Worf. I'll try that and let you know how I get on.

 

[abbeyWigan]

Hi Worf, I've tried it unfortunately it fails with the same error message I was getting with DataRange. When it gets to

pia = pi.DataRange.Cells(1, 1).Row

it throws "Run-time error '1004': Unable to get the DataRange property of the PivotItem class"

 

[Worf]

o Sorry for the late reply.
o Did you change names and indexes to suit your table?
o Can you post a link to a workbook containing a sample table that throws the error?

 

[abbeyWigan]

o Sorry for the late reply.
o Did you change names and indexes to suit your table?
o Can you post a link to a workbook containing a sample table that throws the error?

I've played around and solved the problem. Section of code (with offending line highlighted) posted below. The problem is DataRange property seems to only exist for pivot items that are actually displayed on the screen. This is unlike normal range objects that you can continue to manipulate even when hidden. This means even if the ShowDetail property of the pivot item is set, if the screen is not refreshed to display it, DataRange fails. Through judicious use of ScreenUpdating I have managed to work around this very annoying issue by writing a method to make sure all pivot table fields are expanded and visible then restore all settings back to what it was after the code section above has finished. Slower but it works.

Many thanks for your help.

For x = 0 To UBound(tmp) 'Iterate each field and
    With pt.PivotFields(tmp(x)) 'count the number
        rCnt = 0
        For Each pi In .PivotItems 'of TCR's in each...
            isTc = IsTCR(pi, NoMsg:=True)
            If isTc Then
                cnts(x) = cnts(x) + 1 'Update count

                [u][I][b]Set rng = pi.DataRange: Set rng = rng.Parent.Range("A" & rng.Row)[/b][/I][/u]

                fnd = FindItem(rng.Text, nms(x)) 'See if company name exists.
                If Not fnd Then nms(x) = nms(x) & "," & rng.Text 'If not, add it.
                Set lfm(x) = xUnion(lfm(x), rng)
            End If
        Next pi
    End With
Next x