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

 

[DanteAmor]

Hello @jmon.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

This is what I understand you need:
1)

creating a new tab for each value

2)

drill down from the total for each company (i.e., Company A's total is 78, B's is 119, etc.)

3) Continuing with your example the column of Total (78, 119), is at a displacement of 4 columns with respect to the Company:

4) Checking your macro and the minisheet, the pivot table is on sheet "Sheet2"

-------------------
Then try this.
Change the 4 to the column number you want. in this line:

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

Full macro:

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
    d = pItem.DataRange.Offset(-1, 4).Address
    sh.Range(d).ShowDetail = True
  Next
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[jmon]

Hello @jmon.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

This is what I understand you need:
1)


2)


3) Continuing with your example the column of Total (78, 119), is at a displacement of 4 columns with respect to the Company:

View attachment 91940

4) Checking your macro and the minisheet, the pivot table is on sheet "Sheet2"

-------------------
Then try this.
Change the 4 to the column number you want. in this line:

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

Full macro:

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
    d = pItem.DataRange.Offset(-1, 4).Address
    sh.Range(d).ShowDetail = True
  Next
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

Sorry, it appears I failed to mention that the offset X wouldn't work. The number of lines for each company may vary. In some cases they may have one product (i.e., Gold), in other cases they may have dozens of products.

 

[DanteAmor]

Sorry, it appears I failed to mention that the offset X wouldn't work. The number of lines for each company may vary. In some cases they may have one product (i.e., Gold), in other cases they may have dozens of products.

Did you try my macro?
My macro works for one data for several data from each company.

This for each is per company, not for each item in the table. In your example, the for each only does 3 readings, company A, B and C.
For Each pItem In BillTo.PivotItems


Check the result and tell me what problem you have.

With the data from your example the macro works fine.

If you have problems with some data, then you should post that example so I can look at it.

 

[jmon]

Doh - sorry still trying to wrap my head around VBA.

When I attempt to run the code in the sample file I am getting a run-time error 1004: Unable to set the ShowDetail property of the Range class.

 

[DanteAmor]

As I told you, my macro works with your test data.

If you modified the data or modified the macro, I can't determine why you have an error.

I share my file so you can see how it works.

pivottable2.xlsm

drive.google.com

If you want me to review your data and the operation of the macro, you must share your file.
You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[jmon]

I still get the same run-time error when running your version (downloaded from the google drive above). I have included an image showing your code and the error here. I have also placed a link to my sample file below. This data is safe to share as it is really just a mock up of the actual report.

Sorry - not trying to make things more difficult,

Google Drive link:

Sample.xlsm

Sheet2 Bill To,Item,Sum of Wigwam,Count of Wigit,Sum of This,Sum of That,Sum of Total Company A,Bronze,17,2,8,11,42 Copper,8,1,5,0,14 Gold,8,1,0,10,18 Silver,0,1,4,0,4 Company A Total,33,5,17,21,78 Company B,Copper,15,4,22,10,52 Gold,2,4,17,10,50 Silver,6,1,5,0,17 Company B Total,23,9,44,20,119 ...

docs.google.com

 

[DanteAmor]

It is very rare that you have an error.
Your sample file works without problem, it creates 4 sheets, one for each company and one empty:

_____________________________________________________​

In which version of Excel are you running the macro?
I can see that in your settings you have 365.

Can someone else test the macro on 365 to see if it's a version issue.

_____________________________________________________​

We do something else.
Activate your macro recorder.
In your pivot table, double click on a cell.
Stop the recorder.
Copy the created code and paste it here.

_____________________________________________________​

 

[jmon]

It is very rare that you have an error.
Your sample file works without problem, it creates 4 sheets, one for each company and one empty:

View attachment 91952
View attachment 91953
View attachment 91954

_____________________________________________________​

In which version of Excel are you running the macro?
I can see that in your settings you have 365.

Can someone else test the macro on 365 to see if it's a version issue.

_____________________________________________________​

We do something else.
Activate your macro recorder.
In your pivot table, double click on a cell.
Stop the recorder.
Copy the created code and paste it here.

_____________________________________________________​

I am running it in 365.

Recording a macro, it shows:

Sub Macro1()
'
' Macro1 Macro
'

'
Range("I2").Select
Selection.ShowDetail = True
End Sub

 

[DanteAmor]

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