Pivot Table Code - Is there a better way?

[Juan Correa]

Hello,

I put together a small macro to create a pivot table (with the help of some
of the gurus here).

Here is the code as it is (It works as needed, but I'd like to know if there
is a better way of getting there)...

Sub OrdersCommitPivot()
' Select the source data and copy to a new Workbook
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste

' Rename the worksheets in the new document
ActiveSheet.Name = "Data"
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete


' Declarations
Dim DataWks As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim Pt As PivotTable
Dim MonthLookUp As Long
Dim FGN As Long
Dim ExtAmt As Long
Dim SVT As Long
Dim FunName As Long


' Set the DataWks variable
Set DataWks = Worksheets("Data")

With DataWks
LastRow = Range("A65536").End(xlUp).Row
LastCol = Range("IV1").End(xlToLeft).Column
MonthLookUp = Range("A1", Range("IV1").End(xlToLeft)).Find("Expected
Book Date").Column
SVT = Range("A1", Range("IV1").End(xlToLeft)).Find("Service Revenue
Type").Column
FunName = Range("A1", Range("IV1").End(xlToLeft)).Find("Functional Group
Name").Column
PSCol = Range("A1", Range("IV1").End(xlToLeft)).Find("Top Line Product
Name").Column

' Create the "Booked Month" Column
.Cells(1, LastCol).Copy
.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 1).Value = "Booked Month"
.Columns(LastCol + 1).AutoFit


' Populate the Month Column with new Monts
.Range(.Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1)).Formula = _
"=text(" & .Cells(2, MonthLookUp).Address(0, 0) & ",""mmm"")"


' Create the "Year" Column
.Cells(1, LastCol + 1).Copy
.Cells(1, LastCol + 2).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 2).Value = "Year"
.Columns(LastCol + 2).AutoFit


' Populate the Year Column
.Range(.Cells(2, LastCol + 2), Cells(LastRow, LastCol + 2)).Formula = _
"=YEAR(" & .Cells(2, MonthLookUp).Address(0, 0) & ")"

' Create the FGN column
.Cells(1, LastCol + 2).Copy
.Cells(1, LastCol + 3).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 3).Value = "FGN"
.Columns(LastCol + 3).AutoFit
FGN = Range("A1", Range("IV1").End(xlToLeft)).Find("FGN").Column


' Populate the FGN Column
.Range(.Cells(2, LastCol + 3), Cells(LastRow, LastCol + 3)).Formula = _
"=Trim(" & .Cells(2, FunName).Address(0, 0) & ")"

' Create the Extended Amount (US) Column
.Cells(1, LastCol + 3).Copy
.Cells(1, LastCol + 4).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 4).Value = "Extended Amount (US)"
.Columns(LastCol + 4).AutoFit
ExtAmt = Range("A1", Range("IV1").End(xlToLeft)).Find("Extended Product
Value-US").Column

' Populate the Extended Amount (US) Column
.Range(.Cells(2, LastCol + 4), Cells(LastRow, LastCol + 4)).Formula = _
"=SUMPRODUCT((" & .Cells(2, FGN).Address(0, 0) & " = ""Global
Sales"")*(" _
& .Cells(2, SVT).Address(0, 0) & " <> ""Annuity"")*(" &
..Cells(2, ExtAmt).Address(0, 0) & "))"

End With

ActiveSheet.Calculate

' Create Pivot Table
' Name the list range
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Name = "PivotData"
Range("PivotData").Select


' Crate the Pivot Table based on the list range
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase,
SourceData:="PivotData"). _
CreatePivotTable TableDestination:="", TableName:="MonthlyPivot"


' Set a Pivot Table variable to our new Pivot Table
Set Pt = ActiveSheet.PivotTables("MonthlyPivot")


' Place the Pivot Table to Start from A3 on the new sheet
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Name = "GS Pivot"


' Set the layout of the Pivot Table
Pt.AddFields RowFields:=Array("Forecast Status Description-Current",
"Country Name"), _
ColumnFields:="Booked Month", PageFields:="Year"
With Pt.PivotFields("Extended Amount (US)")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0.000"
End With
Pt.PivotFields("Forecast Status
Description-Current").PivotItems("UPSIDE").Position = 2
Pt.PivotFields("Year").CurrentPage = "2009"
Pt.NullString = "0"
Cells.EntireColumn.AutoFit
ActiveWorkbook.ShowPivotTableFieldList = False
End Sub

The code takes raw data from an internal application and cleans it up a bit.
It adds some columns and populates those columns with the cleansed
information from their respective counterpart columns in the raw data -->
The FGN column is an example where it trims all trailing spaces from the raw
data column so I can then use the trimmed values elsewhere.

The part that I'm trying to improve now is this one:
' Create the Extended Amount (US) Column
.Cells(1, LastCol + 3).Copy
.Cells(1, LastCol + 4).PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(1, LastCol + 4).Value = "Extended Amount (US)"
.Columns(LastCol + 4).AutoFit
ExtAmt = Range("A1", Range("IV1").End(xlToLeft)).Find("Extended Product
Value-US").Column

' Populate the Extended Amount (US) Column
.Range(.Cells(2, LastCol + 4), Cells(LastRow, LastCol + 4)).Formula = _
"=SUMPRODUCT((" & .Cells(2, FGN).Address(0, 0) & " = ""Global
Sales"")*(" _
& .Cells(2, SVT).Address(0, 0) & " <> ""Annuity"")*(" &
..Cells(2, ExtAmt).Address(0, 0) & "))"

As it is... That bit of code creates a new column, names it "Extended Amount
(US)" and populates all the cells in that column with a SUMPRODUCT that
returns the amount for the cells that meet the criteria and zero for the ones
that don't.

The problem rises when my bosses get the pivot and double click on a
subtotal from inside it... the detail worksheet returns all the rows that
add up to that total, including all the rows where the criteria are not met
(and the Ext Amt is zero). But my bosses get confused and start complaining
that the pivot is adding stuff they don't want in there.

My question: Is there a way that I can have the pivot filter out the rows
that don't meet the criteria without using the SUMPRODUCT?

Thanks
Juan Correa

 

[ryguy7272]

You can use a bit of code to essentially disable that Pivot Table (then if
the bosses double click on a subtotal from inside it...nothing happens...)

Put this right at the end of your current code:
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

HTH,
ryan---

 

[Juan Correa]

Thank you Ryan, but this would just cause my bosses to start complaining that
they can't get the detail for a sub-total in the pivot.

I believe I figured out a way of getting it done. It may not be the
cleanest way, but it works.

here's what I did:

1. I changed the Layout of the Pivot (Added to Rows to it).
' Set the layout of the Pivot Table
Pt.AddFields RowFields:=Array("Forecast Status Description-Current",
"Country Name", _
"Functional Group Name", "Service Revenue Type"),
ColumnFields:="Booked Month", PageFields:="Year"

2. I then filtered out what I don't need using the two new row fields.
With Pt.PivotFields("Functional Group Name")
.PivotItems("NCR Consumables Solution").Visible = False
.PivotItems("(blank)").Visible = False
End With


With Pt.PivotFields("Service Revenue Type")
.PivotItems("Annuity").Visible = False
.PivotItems("(blank)").Visible = False
End With

3. I added the following lines of code at the end of the routine:
Range("C4").Select
Selection.ShowDetail = False
Selection.ShowDetail = False
Columns("C").Select
Selection.EntireColumn.Hidden = True

Those lines hide the details from the Pivot for the two rows that I used to
filter out the unwanted data and then I hide the two Columns.

The end result is the same as I had with the original macro, but now when a
sub-total is double-clicked only the rows from the data sheet that meet the
criteria are put in the new worksheet.
Exactly what I need!!!!

Again... this may not be the cleanest way, but it works... so I'm happy.

Thanks again Ryan.

Juan Correa