Macros & Pivot Tables

[ai1094]

Hello,

I am trying to create a macro that creates pivot tables on one sheet. On my first table I set filters to its appropriate values and then I copy that pivot table and insert it a few rows under and this second pivot will have the same format but different filters. My goal is to have 5 pivot tables into one sheet, but I believe my errors occur because of the Pivot Table name. I've highlighted the code that gives me the error in red[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=000]#000[/URL] 000][/COLOR][COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=000]#000[/URL] 000]. Is there a simple solution to this so I can run the macro on any excel file that has the same format but different data?[/COLOR]

Here is some of my code:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R221674C115", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="" & wsNew.Name & "!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("BUILDING_LOCID")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_CODE")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_STATUS_NAME")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("LINE_ITEM_TYPE")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("LINEITEM")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("C_YEAR")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("ACTUALS_RO"), "Sum of ACTUALS_RO", xlSum
ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_CODE").CurrentPage _
= "(All)"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_CODE")
.PivotItems("[NULL]").Visible = False
.PivotItems("A").Visible = False
.PivotItems("B").Visible = False
.PivotItems("C").Visible = False
.PivotItems("D").Visible = False
.PivotItems("E").Visible = False
.PivotItems("F").Visible = False
.PivotItems("P").Visible = False
.PivotItems("R").Visible = False
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_CODE"). _
EnableMultiplePageItems = True
ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_STATUS_NAME"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("OPTION_STATUS_NAME"). _
CurrentPage = "Forecast"
ActiveSheet.PivotTables("PivotTable1").PivotFields("LINE_ITEM_TYPE"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("LINE_ITEM_TYPE"). _
CurrentPage = "P&L"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("LINEITEM")
.PivotItems("CS Total - P&L").Visible = False
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of ACTUALS_RO")
.NumberFormat = "$#,##0.00"
End With
ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("PivotTable1").Name = "Pivot1"
Range("A1:H15").Select
Selection.Copy
ActiveWindow.SmallScroll Down:=12
Range("A26").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=9
ActiveWorkbook.ShowPivotTableFieldList = False
ActiveWorkbook.ShowPivotTableFieldList = True
Range("A26").Select
ActiveSheet.PivotTables("PivotTable2").Name = "Pivot2"
ActiveSheet.PivotTables("Pivot2").PivotFields("OPTION_CODE").CurrentPage = _
"(All)"
With ActiveSheet.PivotTables("Pivot2").PivotFields("OPTION_CODE")
.PivotItems("AUTO RENEWAL").Visible = False
.PivotItems("RO").Visible = False
End With

 

[bobsan42]

I cannot inspect your code now, but you don't give information about the error - pleas do.

And it is a VERY BAD idea to place more than 1 pivot table on one sheet. This is asking for errors.

 

[ai1094]

Bobsan42, are you saying it's not possible to perform this (in VBA?)

 

[bobsan42]

No. It is possible. But placing several pivot tables together on a sheet is tricky and risky. Pivot tables need space to expand (which happens often) and if something gets in the way an errorr will be raised.

 

[Wanderer_geologist]

Hi

As bobsan42 indicated, it's not recommended to create pivot table in the same page due to the automatic expansion and eventual impact on row range due to filtering.

Macro recorder for Pivot table is not your friend at all, at this process is a bit complex and require a precise structure, not captured all the time. One things which is to be noted, the pivot table worksheet MUST be active and visible during the process, I know it sum obscure but well, I learnt it the hard way. Second take, when objects are generated by VBA, first reflex should be to actually destroy the object if it exist before and recreate it after.

I'm going to give snapshoot of code in the few posts below.

 

[Wanderer_geologist]

Below is a snap of the module I was running in the past for a project. I was creating 5 to 6 tables every day through code and form and pass this module to my colleagues when I was off.

With a bit of tweaks and adding data where it suit you, it should be usable.

Sub KPI_CreatePivotTable()


'--------------
' Optimization
'--------------
With Application
.EnableEvents = True
.ScreenUpdating = False
.Calculation = xlCalculationManual
.Calculation = xlCalculationAutomatic
End With




'--------------
'Variable
'-------------


Dim objWs As Worksheet
Dim objPT As PivotTable
Dim objPC As PivotCache
Dim wsSource As Worksheet
Dim WsRef As Worksheet


'------------------------------------
'Test loop to create the sheet if need
'------------------------------------
Dim wsTest As Worksheet
Const strSheetName As String = "Myworksheet" ' This is where you tag the spreadsheet to store 
Set wsTest = Nothing


On Error Resume Next


Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If


'--------------
' Data Storage Location
'--------------
Set objWs = ThisWorkbook.Worksheets(strSheetName)
objWs.Activate


Worksheets(strSheetName)Visible = True ' when finish, set it to False
On Error Resume Next


'---------
'Clear all previous tables in this spreadsheet
'---------
For Each objPT In objWs.PivotTables
    objPT.TableRange2.Clear
Next objPT


'-------------------------------------
' Set the Pivot Table
'------------------------------------
'1- create pivot cache, fetch data
' Need a define Name range for all the dataset, MyDatabase is a named range define during the import process
' here to ease the process, in previous stage, i used to create a named range, instead of mapping an area, it's called myDatabase
Set objPC = ActiveWorkbook.PivotCaches.Create(xlDatabase, "myDatabase")


' 2 - Create the PT


Set objPT = objPC.CreatePivotTable(objWs.Range("A2"), TableName:="my_PT")
objPT.ManualUpdate = True




'----------------------------------
'3 - add the data
'----------------------------------
'3 add row and fields
'X row in the Table


objWs.Activate


   With ActiveSheet.PivotTables("my_PT").PivotFields("MAIN_Y_RECORD") ' main Y record is the field name
      .Orientation = xlRowField
     .Position = 1
    End With


'Add The main record to be scanned and display in the PivoTable


objPT.AddDataField objPT.PivotFields("Duration1"), "Duration", xlSum
  With ActiveSheet.PivotTables("my_PT").PivotFields("Duration1")
        .NumberFormat = "0.00"
    End With
    
'---------------
' Filter 2 set in place (stand counter)
'---------------
 
   With ActiveSheet.PivotTables("my_PT").PivotFields("Margin1")
      .Orientation = xlPageField
     .Position = 1
    End With
  
  objPT.pivofields("Margin1").ClearAllFilters
  objPT.PivotFields("Margin1").CurrentPage = "FALSE"


 '---------------
' Filter 1 set in place (Activity)
'---------------


With ActiveSheet.PivotTables("my_PT").PivotFields("Filter1")
     .Orientation = xlPageField
    .Position = 2
   End With


  objPT.pivofields("Filter1").ClearAllFilters
 With ActiveSheet.PivotTables("my_PT").PivotFields("Filter1")
        .PivotItems("CATegory1").Visible = False
        .PivotItems("No ACTIVITY").Visible = False
     End With
     
     
  objPT.pivofields("Filter1").EnableMultiplePageItems = True


'-------------------
' Optional Filter
'-----------------
Dim BHAFilter1, BHAFilter2 As String


Worksheets("variable").Activate


If Worksheets("Variable").Range("V2").Value <> vbnulstring Then ' initially there was en error by checking the third line of item to ignore....
 'check now if there was something selected
Worksheets("Variable").Range("T1").Value = "BHA_Filter_Variable"
 
'define criteria
BHAFilter1 = Worksheets("Variable").Range("T2").Value
BHAFilter2 = Worksheets("Variable").Range("T3").Value


objWs.Activate


With ActiveSheet.PivotTables("my_PT").PivotFields("BHA_Filter_Variable")
     .Orientation = xlPageField
    .Position = 3
   End With


 ' note to self, you need to know all the filter and blank them beforehand, it
 ' don't recognize the true status but only what is set as False
 
objPT.pivofields("Filter1").ClearAllFilters
 With ActiveSheet.PivotTables("my_PT").PivotFields("BHA_Filter_Variable")
       
        .PivotItems(BHAFilter1).Visible = False
        .PivotItems(BHAFilter2).Visible = False
         .PivotItems("(blank)").Visible = False
         .PivotItems("NULL").Visible = False
End With
     
  objPT.pivofields("Filter1").EnableMultiplePageItems = True
 
 
Else
 objPT.pivofields("Filter1").ClearAllFilters
 With ActiveSheet.PivotTables("my_PT")
 .PivotFields("BHA_Filter_Variable")
 End With


End If
    
'---------------
' Add column data
'---------------


  With ActiveSheet.PivotTables("my_PT").PivotFields("State_Name")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    objWs.PivotTables("my_PT").ShowValuesRow = False
  
    With objWs.PivotTables("my_PT")
        .ColumnGrand = False
        .RowGrand = True
    End With




'----------------------------------
'end optimization
'----------------------------------


    objPT.ManualUpdate = False
    objPT.ManualUpdate = True


objWs.Activate


Worksheets(strSheetName).Visible = False ' when finish, set it to False




With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationManual
.Calculation = xlCalculationAutomatic
End With






End Sub

 

[Wanderer_geologist]

Now a few codes which i need to run else before or after this

If you are still using macro command to run some output or to tag some functions, it's easier to use NamedRange function. This particular one can also be controlled through Macro.

 Sub Process_MyDatabase()
 
 '--------------
 ' This code create name range for PT reference and usage
 '--------------
  Dim ws As Worksheet
 Dim ranDatabase As Range, Q As Long
  
 Set ws = ThisWorkbook.Worksheets("Database")
 
 ws.Select
 'assuming that the main record index (continuous one is on the column A)  
   Q = ws.Cells(Rows.Count, "A").End(xlUp).Row
   
   Set ranDatabase = ws.Range(Cells(1, 1), Cells(Q, 27))
   ActiveWorkbook.Names.Add Name:="myDatabase", RefersTo:=ranDatabase
 ws.Range("a1").Select
  MsgBox "Process Done", vbExclamation
 
 End Sub

It happen sometimes, that named range or function are deleted, there is ghost or left over in the workbook, here a simple mean to clean everything.

Sub Delete_Dead_Names()


Dim nName As Name
    For Each nName In Names


        If InStr(1, nName.RefersTo, "#REF!") > 0 Then


            nName.Delete


        End If


    Next nName
    
End Sub

This one is to sanitize or reset the pivot cache, it's helpful and need to be done sometime.

Sub CLEAN_PIVOTTABLE()


Dim pt As PivotTable
Dim wb As Workbook
Dim ws As Worksheet


On Error Resume Next


For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
  
  pt.TableRange2.Clear


  Next pt
Next ws


MsgBox "PT cache empty"


End Sub