J
Juan Correa
Hello,
I have been working on a set of tools for my boss for the past few weeks and
with the help of some of the gurus here I have been able to get them to work
so far. But as you know; the more information you give someone, the more
information they will want and now my boss has asked me to implement
something else for the tool.
Here is what I have so far:
I have a sub() that creates a Pivot Table based on criteria selected by the
user on three cells with lists like this:
Cell 1 -> Country List --> 8 Countries
Cell 2 -> Product Family --> 2 Options
Cell 3 -> Offering Family --> 4 Options
The macro works fine at creating individual pivots based on the selected
criteria. But now my boss has decided that he's lazy and doesn't want to set
up the criteria for all the possible combinations, so he asked me to make a
button that will create ALL the possible Pivot Tables at once.
Here is the code for the macro as it is right now:
Sub CtryPivot()
Application.ScreenUpdating = False
ActiveWindow.DisplayGridlines = False
' Declarations
Dim OptWks As Worksheet
Dim PTCache As PivotCache
Dim ctryParam As String
Dim prdFmly As String
Dim offering As String
Dim DataWks As Worksheet
' Make sure we're looking in the right place
Set OptWks = Worksheets("Options")
ctryParam = OptWks.Range("E7").Value
prdFmly = OptWks.Range("E10").Value
offering = OptWks.Range("E13").Value
' Check that the Parameters Have been entered
On Error Resume Next
If OptWks.Range("E7").Value = "" Or OptWks.Range("E10").Value = "" Or
OptWks.Range("E13").Value = "" Then
MsgBox "Select ALL Paramters" & vbNewLine & "Before Creating" &
vbNewLine _
& "Your Pivot Table", vbCritical, "Warning!"
OptWks.Range("E7").Value = ""
OptWks.Range("E10").Value = ""
OptWks.Range("E13").Value = ""
On Error GoTo 0
Else
' Check that the Pivot doesn't exist
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets(ctryParam & "-" & prdFmly & "-" & offering)
If wSheet Is Nothing Then
' Make sure the Data tab was formatted before generating the Pivot
On Error Resume Next
Set DataWks = Worksheets("Data")
If WorksheetFunction.CountA(DataWks.Cells) = 0 Then
MsgBox "The Data Tab Is Empty" & vbNewLine & "Run the Format
Data" _
& vbNewLine & "Before Creating the Pivot Table", vbCritical,
"Warning!"
Else
' Create the Country Pivot Base On Selected Parameters
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name =
ctryParam & "-" & prdFmly _
& "-" & offering
Set PTCache =
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase,
SourceData:="PivotData")
PTCache.CreatePivotTable TableDestination:=Range("A3"),
TableName:=ctryParam & "Pivot"
ActiveWindow.DisplayGridlines = False
' Set a Pivot Table variable to our new Pivot Table
Set Pt = ActiveSheet.PivotTables(ctryParam & "Pivot")
' The layout of the Pivot Table
Pt.AddFields RowFields:=Array( _
"Forecast Category", "Account Name"), ColumnFields:="Booked
Month", _
PageFields:=Array("Country", "Product Family", "Product
Category")
With Pt.PivotFields("Total Price (converted)")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
With Cells.Font
.Size = 8
End With
With Pt.PivotFields("Product Family")
.CurrentPage = prdFmly
End With
With Pt.PivotFields("Country")
.Orientation = xlPageField
.Position = 3
.CurrentPage = ctryParam
End With
With Pt.PivotFields("Product Category")
.Orientation = xlPageField
.Position = 1
.CurrentPage = offering
End With
' Tiddy up a bit!
Pt.PivotFields("Account Name").AutoSort xlDescending, "Sum of
Total Price (converted)"
Pt.PivotFields("Forecast
Category").PivotItems("Commit").Position = 1
Pt.PivotFields("Forecast
Category").PivotItems("Upside").Position = 2
Pt.PivotFields("Forecast
Category").PivotItems("Pipeline").Position = 3
Pt.PivotFields("Forecast
Category").PivotItems("Closed").Position = 4
Pt.PivotFields("Forecast
Category").PivotItems("Pipeline").ShowDetail = False
Pt.PivotFields("Forecast
Category").PivotItems("Closed").ShowDetail = False
Cells.EntireColumn.AutoFit
OptWks.Range("E7").Value = ""
OptWks.Range("E10").Value = ""
OptWks.Range("E13").Value = ""
ActiveWorkbook.ShowPivotTableFieldList = False
Application.ScreenUpdating = True
Set wSheet = Nothing
On Error GoTo 0
End If
Else
MsgBox "The Pivot Table for:" & vbNewLine & ctryParam & "-" &
prdFmly _
& "-" & offering & vbNewLine & "Allready Exists", vbCritical,
"Warning!"
Set wSheet = Nothing
OptWks.Range("E7").Value = ""
OptWks.Range("E10").Value = ""
OptWks.Range("E13").Value = ""
On Error GoTo 0
End If
End If
Set DataWks = Nothing
End Sub
The code creates a Pivot Table based on the parameters entered into the
predetermined cells in my Options worksheet and then creates a new worksheet
named using those paramters as well. I have checkpoints in there to make
sure that no duplicate worksheets are attempted, and also to make sure that
the parameters have been set before running the macro.
My question is:
How would I go about setting up a modified version of the code so that it
generates all possible combinations of Pivot Tables based on the three
variables (ctryParam, prdFmly, offering)?
My guess is that I'll need to do some sort of For_Next loop, but this would
be the first time I've done loops in VBA and I have no idea how to go about
this.
Thanks
Juan Correa
I have been working on a set of tools for my boss for the past few weeks and
with the help of some of the gurus here I have been able to get them to work
so far. But as you know; the more information you give someone, the more
information they will want and now my boss has asked me to implement
something else for the tool.
Here is what I have so far:
I have a sub() that creates a Pivot Table based on criteria selected by the
user on three cells with lists like this:
Cell 1 -> Country List --> 8 Countries
Cell 2 -> Product Family --> 2 Options
Cell 3 -> Offering Family --> 4 Options
The macro works fine at creating individual pivots based on the selected
criteria. But now my boss has decided that he's lazy and doesn't want to set
up the criteria for all the possible combinations, so he asked me to make a
button that will create ALL the possible Pivot Tables at once.
Here is the code for the macro as it is right now:
Sub CtryPivot()
Application.ScreenUpdating = False
ActiveWindow.DisplayGridlines = False
' Declarations
Dim OptWks As Worksheet
Dim PTCache As PivotCache
Dim ctryParam As String
Dim prdFmly As String
Dim offering As String
Dim DataWks As Worksheet
' Make sure we're looking in the right place
Set OptWks = Worksheets("Options")
ctryParam = OptWks.Range("E7").Value
prdFmly = OptWks.Range("E10").Value
offering = OptWks.Range("E13").Value
' Check that the Parameters Have been entered
On Error Resume Next
If OptWks.Range("E7").Value = "" Or OptWks.Range("E10").Value = "" Or
OptWks.Range("E13").Value = "" Then
MsgBox "Select ALL Paramters" & vbNewLine & "Before Creating" &
vbNewLine _
& "Your Pivot Table", vbCritical, "Warning!"
OptWks.Range("E7").Value = ""
OptWks.Range("E10").Value = ""
OptWks.Range("E13").Value = ""
On Error GoTo 0
Else
' Check that the Pivot doesn't exist
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Sheets(ctryParam & "-" & prdFmly & "-" & offering)
If wSheet Is Nothing Then
' Make sure the Data tab was formatted before generating the Pivot
On Error Resume Next
Set DataWks = Worksheets("Data")
If WorksheetFunction.CountA(DataWks.Cells) = 0 Then
MsgBox "The Data Tab Is Empty" & vbNewLine & "Run the Format
Data" _
& vbNewLine & "Before Creating the Pivot Table", vbCritical,
"Warning!"
Else
' Create the Country Pivot Base On Selected Parameters
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name =
ctryParam & "-" & prdFmly _
& "-" & offering
Set PTCache =
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase,
SourceData:="PivotData")
PTCache.CreatePivotTable TableDestination:=Range("A3"),
TableName:=ctryParam & "Pivot"
ActiveWindow.DisplayGridlines = False
' Set a Pivot Table variable to our new Pivot Table
Set Pt = ActiveSheet.PivotTables(ctryParam & "Pivot")
' The layout of the Pivot Table
Pt.AddFields RowFields:=Array( _
"Forecast Category", "Account Name"), ColumnFields:="Booked
Month", _
PageFields:=Array("Country", "Product Family", "Product
Category")
With Pt.PivotFields("Total Price (converted)")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
With Cells.Font
.Size = 8
End With
With Pt.PivotFields("Product Family")
.CurrentPage = prdFmly
End With
With Pt.PivotFields("Country")
.Orientation = xlPageField
.Position = 3
.CurrentPage = ctryParam
End With
With Pt.PivotFields("Product Category")
.Orientation = xlPageField
.Position = 1
.CurrentPage = offering
End With
' Tiddy up a bit!
Pt.PivotFields("Account Name").AutoSort xlDescending, "Sum of
Total Price (converted)"
Pt.PivotFields("Forecast
Category").PivotItems("Commit").Position = 1
Pt.PivotFields("Forecast
Category").PivotItems("Upside").Position = 2
Pt.PivotFields("Forecast
Category").PivotItems("Pipeline").Position = 3
Pt.PivotFields("Forecast
Category").PivotItems("Closed").Position = 4
Pt.PivotFields("Forecast
Category").PivotItems("Pipeline").ShowDetail = False
Pt.PivotFields("Forecast
Category").PivotItems("Closed").ShowDetail = False
Cells.EntireColumn.AutoFit
OptWks.Range("E7").Value = ""
OptWks.Range("E10").Value = ""
OptWks.Range("E13").Value = ""
ActiveWorkbook.ShowPivotTableFieldList = False
Application.ScreenUpdating = True
Set wSheet = Nothing
On Error GoTo 0
End If
Else
MsgBox "The Pivot Table for:" & vbNewLine & ctryParam & "-" &
prdFmly _
& "-" & offering & vbNewLine & "Allready Exists", vbCritical,
"Warning!"
Set wSheet = Nothing
OptWks.Range("E7").Value = ""
OptWks.Range("E10").Value = ""
OptWks.Range("E13").Value = ""
On Error GoTo 0
End If
End If
Set DataWks = Nothing
End Sub
The code creates a Pivot Table based on the parameters entered into the
predetermined cells in my Options worksheet and then creates a new worksheet
named using those paramters as well. I have checkpoints in there to make
sure that no duplicate worksheets are attempted, and also to make sure that
the parameters have been set before running the macro.
My question is:
How would I go about setting up a modified version of the code so that it
generates all possible combinations of Pivot Tables based on the three
variables (ctryParam, prdFmly, offering)?
My guess is that I'll need to do some sort of For_Next loop, but this would
be the first time I've done loops in VBA and I have no idea how to go about
this.
Thanks
Juan Correa