Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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:=xlDatab ase, 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Create multiple dropdown list for multiple colums; select more tha | Excel Programming | |||
How do I create multiple worksheets from Page Pivots | Excel Worksheet Functions | |||
Need to create unique list from list of multiple entries | Excel Programming | |||
I would like to build macro's to do pivots or part of pivots | Excel Programming | |||
Pivots using other pivots and dynamic query problem | Excel Programming |