For Each Loop in Pivot Table

[jmon]

I am trying to write a for each loop that will run through a pivot table and drill down to one of the values in the pivot table (creating a new tab for each value). Using the info from the sample picture, I am trying to get a drill down from the total for each company (i.e., Company A's total is 78, B's is 119, etc.). I've searched all over and cannot seem to find any code that works in this case (or perhaps that I can understand).

I am able to make this work if I went through and called out each "Bill To" separately, but that won't work as the list changes. I desperately need help figuring out how I can loop through the list and extract a new tab for each "Bill to" by referencing the pivot table itself. Any help would be greatly appreciated.

Here is a snip of the existing code:

Windows("Sample").Activate
ThisWorkbook.Activate
Sheets("Sheet2").Select

Dim PvtTbl As PivotTable
Dim PvtFlds As PivotField
Dim PvtFld As PivotField
Dim Total As PivotField
Dim BillTo As PivotField


Set PvtTbl = Sheets("Sheet2").PivotTables("Pivottable2")
Set BillTo = PvtTbl.PivotFields("Bill To")
Set Total = PvtTbl.PivotFields("Total")

With Sheets("Sheet2").PivotTables("Pivottable2")
Dim d As Variant
On Error GoTo Error
With Sheets("Invoicing").PivotTables("PivotTable3")
d = .GetPivotData("Total", "BillTo")
d = .GetPivotData("Total", "BillTo").Address
Range(d).ShowDetail = True
End With
****perform actions with sheets

Next
End With

Sample.xlsx
	D	E	F	G	H	I
1	Row Labels	Sum of Wigwam	Count of Wigit	Sum of This	Sum of That	Sum of Total
2	Company A	33	5	17	21	78
3	Bronze	17	2	8	11	42
4	Copper	8	1	5	0	14
5	Gold	8	1	0	10	18
6	Silver	0	1	4	0	4
7	Company B	23	9	44	20	119
8	Copper	15	4	22	10	52
9	Gold	2	4	17	10	50
10	Silver	6	1	5	0	17
11	Company C	80	16	45	48	235
12	Bronze	19	2	3	4	36
13	Copper	9	2	11	5	36
14	Gold	18	3	1	5	33
15	Silver	34	9	30	34	130
16	(blank)
17	(blank)
18	Grand Total	136	30	106	89	432
Sheet2

 

[jmon]

Very weird

Try the following change:

Sub ForEachPivotTable()
  Dim sh As Worksheet
  Dim PvtTbl As PivotTable
  Dim BillTo As PivotField
  Dim pItem As PivotItem
  Dim d As String
 
  Set sh = Sheets("Sheet2")
  Set PvtTbl = sh.PivotTables("Pivottable2")
  Set BillTo = PvtTbl.PivotFields("Bill To")
 
  For Each pItem In BillTo.PivotItems
    sh.Select
    d = pItem.DataRange.Offset(-1, 4).Address
    Range(d).ShowDetail = True
  Next
End Sub

No luck. Still getting the same run time error on Range(d).ShowDetail = True

 

[jmon]

I think I found the issue. If I change this line:

d = pItem.DataRange.Offset(-1, 4).Address

to:

d = pItem.DataRange.Offset(0, 4).Address

It works properly.

Would you happen to know a quick way to have it ignore the (blank) line in the pivot table?

 

[DanteAmor]

d = pItem.DataRange.Offset(0, 4).Address

Something like that I supposed.
But with 0 in the new sheet is the data you need to see correct?

Would you happen to know a quick way to have it ignore the (blank) line in the pivot table?

Try this:

Sub ForEachPivotTable()
  Dim sh As Worksheet
  Dim PvtTbl As PivotTable
  Dim BillTo As PivotField
  Dim pItem As PivotItem
  Dim d As String
 
  Set sh = Sheets("Sheet2")
  Set PvtTbl = sh.PivotTables("Pivottable2")
  Set BillTo = PvtTbl.PivotFields("Bill To")
 
  For Each pItem In BillTo.PivotItems
    If pItem.Name <> "(blank)" Then
      d = pItem.DataRange.Offset(0, 4).Address
      sh.Range(d).ShowDetail = True
    End If
  Next
End Sub

 

[jmon]

Something like that I supposed.
But with 0 in the new sheet is the data you need to see correct?

Yes, it is. I determined it was pulling the wrong column after using debug.print. The values it returned for (-1, 4) were incorrect.

Thank you for the additional code, that worked perfectly.

And thank you for all your help! It is greatly appreciated!!