Create Reports for Each Region or Model
A pivot table can have one or more page fields. A page field goes in a separate set of rows above the pivot report. It can serve to filter the report to a certain region, a certain model, or a certain combination of region and model.
To set up a page field in VBA, add the PageFields parameter to the AddFields method. The following line of code creates a pivot table with Region in the page field:
PT.AddFields RowFields:="Model", ColumnFields:="Data", PageFields:="Region"
The preceding line of code sets up the Region page field set to the value (All), which returns all regions. To limit the report to just the North region, use the CurrentPage property:
PT.PivotFields("Region").CurrentPage = "North"
One use of a page field is to build a user form where someone can select a particular region or a particular product. You then use this information to set the CurrentPage property and display the results of the user form.
Another interesting use is to loop through all PivotItems and display them one at a time in the page field. You can quickly produce top 10 reports for each region using this method.
To determine how many regions are available in the data, use PT.PivotFields("Region").PivotItems.Count. Either of these loops would work:
For i = 1 To PT.PivotFields("Region").PivotItems.Count
PT.PivotFields("Region").CurrentPage = _
PT.PivotFields("Region").PivotItems(i).Name
PT.ManualUpdate = False
PT.ManualUpdate = True
Next i
For Each PivItem In PT.PivotFields("Region").PivotItems
PT.PivotFields("Region").CurrentPage = PivItem.Name
PT.ManualUpdate = False
PT.ManualUpdate = True
Next PivItem
Of course, in both of these loops, the three region reports fly by too quickly to see. In practice, you would want to save each report while it is displayed.
So far in this tutorial, you have been using PT.TableRange2 when copying the data from the pivot table. The TableRange2 property includes all rows of the pivot table, including the page fields. There is also a .TableRange1 property, which excludes the page fields. You can use either statement to get the detail rows:
PT.TableRange2.Offset(3, 0) PT.TableRange1.Offset(1, 0)
Which you use is your preference, but if you use TableRange2, you won't have problems when you try to delete the pivot table with PT.TableRange2.Clear. If you were to accidentally attempt to clear TableRange1 when there are page fields, you would end up with the dreaded "Cannot move or change part of a pivot table" error.
Listing 8 produces a new workbook for each region, as shown in Figure 20.
Listing 8. Code That Creates a New Workbook per Region
Sub Top5ByRegionReport()
' Produce a report of top 5 stores for each region
Dim WSD As Worksheet
Dim WSR As Worksheet
Dim WBN As Workbook
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Set WSD = Worksheets("PivotTable")
' Delete any prior pivot tables
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT
' Define input area and set up a Pivot Cache
FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Application.Columns.Count). _
End(xlToLeft).Column
Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
xlDatabase, SourceData:=PRange.Address)
' Create the Pivot Table from the Pivot Cache
Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
Cells(2, FinalCol + 2), TableName:="PivotTable1")
' Turn off updating while building the table
PT.ManualUpdate = True
' Set up the row fields
PT.AddFields RowFields:="Store", ColumnFields:="Data", _
PageFields:="Region"
' Set up the data fields
With PT.PivotFields("Revenue")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "#,##0,K"
.Name = "Total Revenue"
End With
' Sort stores descending by sum of revenue
PT.PivotFields("Store").AutoSort Order:=xlDescending, _
Field:="Total Revenue"
' Show only the top 5 stores
PT.PivotFields("Store").AutoShow Type:=xlAutomatic, Range:=xlTop, _
Count:=5, Field:="Total Revenue"
' Ensure that you get zeroes instead of blanks in the data area
PT.NullString = "0"
' Calc the pivot table
PT.ManualUpdate = False
PT.ManualUpdate = True
Ctr = 0
' Loop through each region
For Each PivItem In PT.PivotFields("Region").PivotItems
Ctr = Ctr + 1
PT.PivotFields("Region").CurrentPage = PivItem.Name
PT.ManualUpdate = False
PT.ManualUpdate = True
' Create a new blank workbook with one worksheet
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSR = WBN.Worksheets(1)
WSR.Name = PivItem.Name
' Set up Title for Report
With WSR.[A1]
.Value = "Top 5 Stores in the " & PivItem.Name & " Region"
.Font.Size = 14
End With
' Copy the pivot table data to row 3 of the report sheet
' Use offset to eliminate the page & title rows of the pivot table
PT.TableRange2.Offset(3, 0).Copy
WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
LastRow = WSR.Cells(65536, 1).End(xlUp).Row
WSR.Cells(LastRow, 1).Value = "Top 5 Total"
' Do some basic formatting
' Autofit columns, bold the headings, right-align
WSR.Range(WSR.Range("A2"), WSR.Cells(LastRow, 3)).Columns.AutoFit
Range("A3").EntireRow.Font.Bold = True
Range("A3").EntireRow.HorizontalAlignment = xlRight
Range("A3").HorizontalAlignment = xlLeft
Range("B3").Value = "Revenue"
Range("A2").Select
Next PivItem
' Clear the pivot table
PT.TableRange2.Clear
Set PTCache = Nothing
MsgBox Ctr & " Region reports have been created"
End Sub
20. By looping through all items found in the Region page field, the macro produced one workbook for each regional manager.
