How do I loop thru a data range in a pivot table

Question

I have two pivot tables.  I want to use VBA to extract the data displayed on each table and put it on another sheet, to make a report.   

How do I do that.

Basically, I want to loop thru the data on each, and when there are differences (both pivot tables have the exact same filters) I want to put the differences, including deleted and added items on a new sheet.

Answer 1

Your question at the moment is rather general.

We would be better able to help you if:

• you shared a picture of the pivot table
• you indicated which fields would need to be checked for additions and deletions
• you showed an example of how you would want the differences to be indicated - including changed data values, additions and deletions.

Answer 2

The first pivot table is the old data; the second is the new data.  The resulting output is at the bottom. And if the difference is within a threshold given by the user, I need to show those data that fall outside of the threshold.  And only visible fields should show up on the report. When I select a color, I should only see that color in each pivot table and the resulting report. The resulting data is replaced every time I select a different color.

Answer 3

Let's start with the easy bits:

• the colouring can be done using conditional formatting
• the computation of differences can, if the field names match up with those in the pivot tables correctly, be done using GETPIVOTDATA on each table and wrapping each GETPIVOTDATA call in IFERROR( ..., 0).

  To turn the column headings into correct field names for the pivot tables you may need to do ="Sum of (-3) " & TheCellcontaining the column heading.

• "deleted" and "new" can be computed using formulas like IF(ISERROR(GETPIVOTDATA(....)),"deleted,"")

That leaves the problem of how to populate the row and column headings.

• you could update them manually
• otherwise a macro that loops through the PivotItems of the PivotFields concerned.

If you need further help on any part of this do come back.

It would be even easier to provide that help if we had access to an example workbook so that we can reference the correct field names etc.

Answer 4

I can't seem to upload a spreadsheet.  The data is in the tables below. I have the pivot table set so that the "Product" are in alphabetical order. The Products can change at anytime, which is why I need to know what was added and what was deleted.  Thank you for looking at this.  I have actually figured that it might be best if I create two VBA arrays from the data, compare the data in VBA, and print out the results. But I'm stuck now. My code is below also.

Here is the old data

Product	Color	(-3) Mar 16	(-2) Apr 16	(-1) May 16	Current Jun 16	(+1) Jul 16	(+2) Aug 16	(+3) Sep 16
Product A	Blue	4.20	19.42	20.96	46.42	27.56	41.96	27.09
Product B	Red	6.72	48.42	43.75	1.78	42.49	42.85	14.84
Product C	Green	24.68	47.16	46.65	40.94	37.45	13.39	20.56
Product D	Red	7.29	47.57	29.16	46.25	32.31	29.66	31.78
Product A	Blue	49.25	19.82	33.57	17.72	18.79	0.39	20.33
Product B	Red	39.27	46.23	46.40	36.66	10.28	9.67	47.15
Product C	Blue	7.97	25.48	42.07	6.68	11.81	37.95	0.45
Product D	Red	29.83	5.58	20.28	22.50	32.99	27.56	31.53
Product A	Green	0.78	26.39	44.50	15.54	36.36	11.73	19.42
Product B	Yellow	27.04	35.26	1.72	42.32	21.85	15.10	4.45
Product C	Blue	42.16	20.80	48.60	15.82	26.70	13.69	19.78
Product D	Red	0.36	10.83	20.26	6.99	35.04	13.25	38.56
Product A	Green	35.27	5.19	10.87	48.60	8.28	6.26	36.65
Product B	Yellow	30.29	40.42	37.25	33.82	22.41	5.59	2.86
Product C	Yellow	27.90	46.04	33.45	21.19	43.29	10.78	19.78
Product D	Blue	32.62	27.66	19.41	7.51	44.78	21.69	35.57
Product A	Red	4.71	16.36	43.24	13.03	2.90	7.59	0.03
Product B	Green	7.83	47.28	44.73	14.09	41.79	28.68	34.98

Here is the new data (note, I changed this data a little, just to illustrate that the new data could change at anytime)

Product	Color	(-3) Apr 16	(-2) May 16	(-1) Jun 16	Current Jul 16	(+1) Aug 16	(+2) Sep 16	(+3) Oct 16
Product A	Blue	31.70	8.39	23.59	23.52	21.30	23.66	12.07
Product B	Red	7.41	20.07	10.59	45.39	37.04	4.17	27.04
Product C	Green	23.98	49.49	45.10	33.91	39.47	32.23	31.61
Product E	Yellow	36.61	10.78	46.16	39.58	2.21	27.63	9.14
Product A	Blue	13.23	48.97	24.48	2.76	49.67	30.97	22.50
Product B	Red	6.23	10.80	23.04	14.89	48.11	31.19	5.35
Product C	Blue	42.83	2.27	4.25	33.30	49.91	9.53	16.08
Product E	Red	17.49	16.30	47.08	26.38	48.03	21.50	44.26
Product A	Green	26.20	44.20	36.09	8.47	49.99	25.60	19.57
Product B	Yellow	17.64	24.05	11.64	27.21	30.64	29.89	29.58
Product C	Blue	18.50	9.62	40.05	19.10	13.86	21.85	43.37
Product E	Red	2.50	18.34	11.35	44.54	9.79	16.68	35.80
Product F	Green	25.27	12.41	15.62	43.31	37.30	28.52	41.11
Product B	Yellow	6.92	32.85	11.44	43.47	46.12	6.00	11.42
Product C	Yellow	32.31	15.71	48.85	7.51	30.54	12.57	8.00
Product E	Fushia	27.89	30.98	25.29	18.88	30.15	41.02	3.71
Product A	Red	47.30	6.84	42.49	46.25	48.36	11.16	39.32
Product B	Green	34.61	48.54	4.56	40.67	11.28	24.95	5.71
Product F	Blue	27.89	30.98	25.29	18.88	30.15	41.02	3.71
Product F	Red	47.30	6.84	42.49	46.25	48.36	11.16	39.32
Product F	Green	34.61	48.54	4.56	40.67	11.28	24.95	5.71

Sub CreateDataArray()

Dim pt As PivotTable

Dim rCell As Range

Dim rCol As Range

Dim rDataRng As Range

Dim rPgmsRng As Range

Dim rMonthsRng As Range

Dim RptRng, MonthText As String

Dim theDataArray, thePgmsArray, theMonthsArray As Variant

Dim i, j As Integer

With Sheets("OldSheet")

    Set pt = .PivotTables("OldPivot")

    Set rDataRng = pt.DataBodyRange

    Set rPgmsRng = pt.PivotFields("Product").DataRange

    Set rMonthsRng = pt.PivotFields("Values").DataRange

End With

ReDim theDataArray(rDataRng.Columns.Count + 1, rDataRng.Rows.Count)

ReDim thePgmsArray(rPgmsRng.Columns.Count)

ReDim theMonthsArray(rMonthsRng.Rows.Count)

Debug.Print rDataRng.Columns.Count, rDataRng.Rows.Count, rPgmsRng.Columns.Count, rMonthsRng.Rows.Count

' create the Product Names column

i = 0

For Each rCell In rPgmsRng.Columns

    theDataArray(i, 0) = rCell.Value

    i = i + 1

Next rCell

' create the rest of the data array

i = 0

j = 0

For Each rCol In rDataRng.Columns

    For Each rCell In rCol.Rows

        theDataArray(i, j + 1) = rCell.Value

        Debug.Print rCell.Address, i, j + 1, rCell.Value, theDataArray(i, j + 1)

        j = j + 1

    Next rCell

    j = 0

    i = i + 1

Next rCol

' Get the months headings

j = 0

For Each rCell In rMonthsRng.Rows

    theMonthsArray(j) = "'" & Right(rCell.Text, 6)   ' put a quote first, so that excel does not change this to a date

    Debug.Print theMonthsArray(j)

    j = j + 1

Next rCell

**** this is where I'm stuck, how do I get the month headings in (I can use this same code to create the "new data" array) and then how do I create the code to run thru a compare of the data and then print it?  *******

End Sub

Answer 5

I note your message but am away overnight.  Reply will be delayed until I get to a larger screen than my phone