Pivot Table Macro

[Skeddy]

I use a lot of Pivot tables at my work place, and runnig out of memory is a
big issue, as well as generating / "Show all pages" in the work sheet.

I want to build a macro that will allow me to run it, and for each field in
the pivot table, slect it and then print, and then go onto the next one.

The macro that I have set up at the moment is:
------------------------------------------
Sub pivot()
'
' pivot Macro
' Macro Recorded 09/03/2004 by Robert Sked
'

ActivateSheet.PivotTables("ShopStock").PivotFields("Shop Name").CurrentPage
= _
"Andover"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActivateSheet.PivotTables("ShopStock").PivotFields("Shop Name").CurrentPage
= _
"Boston"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActivateSheet.PivotTables("ShopStock").PivotFields("Shop Name").CurrentPage
= _
"Bedford"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

--------------------------------------------------

For each line that has the Shop Name, i.e. Boston, Bedford, Andover, these
are the drop down fields in the top of my pivot table. If I select a "Shop
Name" the Pivot table is updated to show me what stock they sold.

I have to attach a page if this to each Invoice that I do for the shop, and
this is why I am using the "Show All Pages" option, as I can then select the
100 or so tabs and sety up all the page headers and footers and then print
them all out.

The above macro does this but onlt using the main data as it were in the
work sheet. I'm looking for a way that I can get the macro to reapeat each
this for eveey "Shop Name" in the pivot table, and then end once it's done
them all.

Any thoughts ?

A friend has told me taht I would need to set up a variable for the "Shop
Name" and basically have it "+1" eadh time until it ends.

Once I get this set up, I would use this macro on multiple sheets when I
need to print out the data, so the range could be from 10 to 100 shops ech
time.

Any help/advice would be great !

Rob
http://skeddy.net

 

[Debra Dalgleish]

The following code will print (or preview, for testing) a copy of the
pivot table for each item in the page field.

'=====================
Sub PrintPivotPages()
'prints a copy of pivot table for
'each item in page field
On Error Resume Next
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Set pt = ActiveSheet.PivotTables.Item(1)
For Each pf In pt.PageFields
For Each pi In pf.PivotItems
pt.PivotFields(pf.Name).CurrentPage = pi.Name
' ActiveSheet.PrintOut 'use this for printing
ActiveSheet.PrintPreview 'use this for testing
Next
Next pf
End Sub
'====================

 

[Skeddy]

This is absolutly super Debra, works great !

No more memory problems for me.

Thanks you once again, super, super, super.

 

[Skeddy]

Would there be any reason why this would not work correctly with Excel 2000
?

I ran the routine perfectly on Excel XP, but when using the same code on
Excel 2000 in my workplace, once it reached the last item in the PageField,
it got stuck in a loop just on that item.

 

[Debra Dalgleish]

It worked for me in Excel 2000, but you could try the following
variation instead:

'=============
Sub PrintPivotPagesCount()
'prints a copy of pivot table for
'each item in page field
'--assumes one page field
On Error Resume Next
Dim pt As PivotTable
Dim pf As PivotField
Dim i As Integer

Set pt = ActiveSheet.PivotTables.Item(1)
For Each pf In pt.PageFields
For i = 1 To pf.PivotItems.Count
Debug.Print pf.PivotItems(i).Name
pt.PivotFields(pf.Name).CurrentPage = _
pf.PivotItems(i).Name
' ActiveSheet.PrintOut 'use for printing
ActiveSheet.PrintPreview 'use for testing
Next
Next pf
End Sub
'=========================

 

[Skeddy]

Excellent, I'll give that a try in the morning.

I found that it look like Excel don't like me to remove coloums and then
update the pivot table, as I did a new worksheet with the macro and it
worked fine.

Thank you ever so much again. IT love that fact that they don't have to
shell out £50 for some more memory.

Thank you !!!

 

[Debra Dalgleish]

You're welcome! And thanks for the update on the macro.