I recorded a macro in which I want to create a pivot table into a new worksheet. I am using 2010 version.
I have the "Run time error 5" Invalid procedure call or argument" error when I want to run a macro. Please see the code. It creates the new sheet so is it not fine?
Range("A1").Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R17445C24", Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="Sheet4!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion12
Sheets("Sheet4").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Bnlunit")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Period")
.Orientation = xlColumnField
.Position = 1
End With
ActiveWindow.SmallScroll Down:=12
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Amount"), "Sum of Amount", xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Hdaccount_agr_3(T)")
.Orientation = xlRowField
.Position = 1
End With
ActiveWindow.SmallScroll Down:=-33
End Sub
The problem is because of sheet name and not deleting those sheets. I think the below code could be of your help
Sub Macro1()
'
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Raw Data")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PRIMEPivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable_(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable")
'Insert Column Fields
'With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("ColumnName")
'.Orientation = xlColumnField
'.Position = 1
'End With
'Insert Row Fields
With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("RowName")
.Orientation = xlRowField
.Position = 1
End With
'Insert Data Field
With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("Field 1")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.Name = "Name of your choice"
End With
End Sub
Try the code below, explanations inside the code's comments:
Option Explicit
Sub VBAPivot()
Dim Sht1 As Worksheet
Dim NewSht As Worksheet
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim PvtRange As Range
Dim LastRow As Long
Set NewSht = ThisWorkbook.Sheets.Add ' add new sheet
Set Sht1 = ThisWorkbook.Worksheets("Sheet1")
With Sht1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' set the PivotCach DataSource Range
Set PvtRange = .Range("A1:X" & LastRow)
End With
' Set the Pivot Cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, PvtRange.Address(False, False, xlA1, xlExternal))
' create a new Pivot Table in the new added sheet, in "A3"
Set PvtTbl = NewSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=NewSht.Range("A3"), TableName:="PivotTable1")
With PvtTbl ' modify Pivot-Table properties
With .PivotFields("Bnlunit")
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields("Period")
.Orientation = xlColumnField
.Position = 1
End With
' add Field as Sum of
.AddDataField .PivotFields("Amount"), "Sum of Amount", xlSum
With .PivotFields("Hdaccount_agr_3(T)")
.Orientation = xlRowField
.Position = 1
End With
End With
End Sub
Related
Any help would be appreciated. The Code below was working previously, now it is not. I have the exact same code for a different PIVOT table down below this one and it works perfectly. I'm scratching my head on this one.
'Pivot Tables
Sub TestPivot()
Sheets("Reported Sales").Select
'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Declare Variables
Application.DisplayAlerts = False
Worksheets("Pivot Reported Sales").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "Pivot Reported Sales"
Application.DisplayAlerts = True
Set PSheet = Worksheets("Pivot Reported Sales")
Set DSheet = Worksheets("Reported Sales")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange).CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
TableName:="Pivot Reported Sales")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(2, 2), TableName:="Pivot Reported Sales")
'Insert Row Fields
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("PROD_BASE_CD")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("Product Description")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("Compensation Category")
.Orientation = xlRowField
.Position = 3
End With
'Insert Data Field
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("PROD_SALES_AMT")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "$#,##0"
End With
With ActiveSheet.PivotTables("Pivot Reported Sales").PivotFields("INVC_DATE")
.Orientation = xlPageField
.Position = 1
End With
End Sub
I'm trying to put two pivot tables into the same sheet but my second pivot table is not being created when I step into VBA. The code runs without any errors, but the second pivot table is never created. I'm looking to eventually add many pivot tables to the same sheet so any help with this would be appreciated.
I've tried setting two different caches, but I don't believe that will help solve this specific problem. I've also tried
Sub CreatePivottablewithVBA()
'Declare Variables
Dim Psheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim Ptable As PivotTable
Dim Ptable2 As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set Psheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Raw")
'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=Psheet.Cells(2, 2), _
TableName:="SalesbyYearMonth")
'Insert Blank Pivot Table
Set Ptable = PCache.CreatePivotTable _
(TableDestination:=Psheet.Cells(1, 1), TableName:="SalesbyYearMonth")
'Insert Row Fields
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("ck_complete_dt")
.Orientation = xlRowField
.Position = 2
End With
'Insert Data Field
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("total_amount")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.Name = "# of Sales"
End With
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("total_amount")
.Orientation = xlDataField
.Position = 2
.NumberFormat = "$#,##0.00"
.Function = xlSum
.Name = "Total Amount"
End With
With ActiveSheet.PivotTables("SalesbyYearMonth").PivotFields("total_amount")
.Orientation = xlDataField
.Position = 3
.Calculation = xlPercentOfTotal
.NumberFormat = "0.00%"
.Name = "% of Total"
End With
'Format Pivot Table
ActiveSheet.PivotTables("SalesbyYearMonth").ShowTableStyleRowStripes = True
ActiveSheet.PivotTables("SalesbyYearMonth").TableStyle2 = "PivotStyleMedium9"
PivotTable.DataOnRows = False
'Create PivotTable2
Set Ptable2 = PCache.CreatePivotTable(TableDestination:=Psheet.Cells(22, 2), TableName:="SalesPerCategory")
With ActiveSheet.PivotTables("SalesPerCategory").PivotFields("highest_categ_level")
.Orientation = xlRowField
.Position = 1
.Name = "Category"
End With
With ActiveSheet.PivotTables("SalesPerCategory").PivotFields("highest_categ_level")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.Name = "Count of Categories"
End With
End Sub
I don't receive any error messages but I expect to see both pivot tables created in the sheet PivotTable
I have been trying for hours now to create a pivot table from VBA. I've tried various codes but i keep getting errors. The following code does not create a pivot table it only creates a new sheet. I have a sheet called "Base" where all my data is. It has 18288 rows and 13 columns with data. Can anyone help me with why the code isn't working for me
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As range
Dim LastRow As Long
Dim LastCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Base")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")
Sheets("PivotTable").Select
With ActiveSheet.PivotTables("PivotTable").PivotFields("FACULTY_ID")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable").PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End Sub
This might work for you:
Sub pivottable()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As pivottable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim new_sheet As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Application.DisplayAlerts = True
On Error GoTo 0
new_sheet_name = "PivotTable"
pivot_table_name = "pivot_name_here"
Set new_sheet = Sheets.Add(Before:=ActiveSheet)
With new_sheet
.Name = new_sheet_name
End With
Set PSheet = new_sheet
Set DSheet = Worksheets("Base")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=PRange.Address(, , xlR1C1))
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1).Address(, , xlR1C1), TableName:=pivot_table_name)
With PTable.PivotFields("FACULTY_ID")
.Orientation = xlRowField
.Position = 1
End With
With PTable.PivotFields("PROGRAM_TYPE_NAME")
.Orientation = xlRowField
.Position = 2
End With
With PTable
.AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("PROGRAM_TYPE_LETTER"), "Sum of amount", xlSum
End With
End Sub
Looks like this link is cold, but in case someone else wants to do this, here's code I adapted from other answers (StackOverflow and elsewhere) to create several Pivot Tables. This code receives a Global Variable from above that is an array with 7 salesman's names. The code:
Finds the range of the data on each "salesman's" sheet.
Creates a Pivot Table Cache with the salesman's name (this was the key to getting it to work).
Creates a Pivot table with the salesman's name.
Labels and sorts the Pivot Table.
Moves on to the next Sheet.
Sub Pivot_Maker() 'adapted from the internet. I added the arrays tho - AAI
'as of 11/26/2019
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl(7) As PivotTable
Dim DataRng As Range
Dim TableDest As Range
i = 0
Do While i < NumSalesPeeps
Sheets(Salesman(i)).Select
Range("A1").Select
If IsEmpty(Range("A30")) Then GoTo No_Data
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = ActiveSheet.Name
PvtTblName = ActiveSheet.Name & "pvt"
' set data range for Pivot Table
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 10)) ' conversion of R1C1:R & FinalRow & C8
' set range for Pivot table placement
Set TableDest = Sheets(DataSheet).Cells(1, 12) ' conversion of R1C9
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)
' this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl(i) Is Nothing Then ' PvtTblName doesn't exist >> create it
' create a new Pivot Table in PvtTblName sheet
Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:=PvtTblName)
With PvtTbl(i).PivotFields("Account")
.Orientation = xlColumnField
.Position = 1
End With
With PvtTbl(i).PivotFields("Name")
.Orientation = xlRowField
.Position = 1
End With
PvtTbl(i).AddDataField ActiveSheet.PivotTables( _
PvtTblName).PivotFields("Amount"), "Sum of Amount", xlSum
Else
' just refresh the Pivot cache with the updated Range
PvtTbl(i).ChangePivotCache PvtCache
PvtTbl(i).RefreshTable
End If
With ActiveSheet.PivotTables(PvtTblName).PivotFields("Sum of Amount")
.NumberFormat = "$#,##0"
End With
No_Data:
i = i + 1
Loop
End Sub
I have written below code to generate a pivot from sheet named Data it works if data is till column Z if the data goes beyond col Z. it does not work.
Need Someone to check the code & help me figure out what could be the possible error here.
Sub pivot()
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Data")
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="Status")
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="Status")
With ActiveSheet.PivotTables("Status").PivotFields("Region")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Status").PivotFields("Final Owner")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveSheet.PivotTables("Status").PivotFields("Incident ID")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.NumberFormat = "#,##0"
.Name = "Count"
End With
End Sub
Try modifying your PivotCache line to:
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange.Address(False, False, xlA1, xlExternal)). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), TableName:="Status")
I have recorded a macro to create a Pivot Chart. The Data Source is defined as a variable because the data keeps on changing. The macro ran well for a fewer number of rows (up till 20 no.). But as the data increases beyond the 20 no. of rows, the macro shows a
Run-time error 13: Type mismatch.
The code is as below. The highlighted part shows error
Dim s As Worksheet, t As String
Dim i As Long, K As Long
K = Sheets.Count
For i = K To 1 Step -1
t = Sheets(i).Name
If t = "COMPARISON" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "COMPARISON"
Sheets("FRONT PAGE").Select
Nobid = Cells(11, 4)
Sheets("ARRANGED BIDS").Select
Finalrow = Cells(Rows.Count, 1).End(xlUp).Row
**ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Sheets("ARRANGED BIDS").Range(Cells(2, 1), Cells(Finalrow, (7 + 2 * Nobid))), Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="COMPARISON!R1C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion15**
Sheets("COMPARISON").Select
Cells(1, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("COMPARISON!$A$1:$C$18")
ActiveSheet.Shapes("Chart 1").IncrementLeft 192
ActiveSheet.Shapes("Chart 1").IncrementTop 15
With ActiveChart.PivotLayout.PivotTable.PivotFields("Item No.")
.Orientation = xlRowField
.Position = 1
End With
With ActiveChart.PivotLayout.PivotTable.PivotFields("Item Description")
.Orientation = xlRowField
.Position = 2
End With
With ActiveChart.PivotLayout.PivotTable.PivotFields("Quantity")
.Orientation = xlRowField
.Position = 3
End With
ActiveWindow.SmallScroll Down:=-6
With ActiveChart.PivotLayout.PivotTable.PivotFields("Item No.")
.Orientation = xlRowField
.Position = 3
End With
With ActiveChart.PivotLayout.PivotTable.PivotFields("Quantity")
.Orientation = xlRowField
.Position = 1
End With
Please, someone, help me resolve the error.
Thanks
Try the code below, it should take of you error, and all the PivotTable setting. Explanation are inside the code comments.
Note: I’ve removed all of the unqualified Range and Cells, and also the un-necessary Select, which slows the code down.
Code
Option Explicit
Sub copy_to_report()
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim PvtRng As Range
Dim ws As Worksheet
'Dim t As String
Dim i As Long
Dim FinalRow As Long
Dim Nobid As Long
Application.DisplayAlerts = False
' loop through all sheets, if one of them is name "COMPARISON" delete it
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "COMPARISON" Then ws.Delete
Next ws
Application.DisplayAlerts = True
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "COMPARISON"
' ***** THIS is the only variable I'm not sure what it's used for *****
Nobid = Sheets("FRONT PAGE").Cells(11, 4)
With Sheets("ARRANGED BIDS")
' find last row in column "A" in "ARRANGED BIDS" sheet
FinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' set the Range for the Pivot Cache
Set PvtRng = .Range(.Cells(2, 1), .Cells(Finalrow, (7 + 2 * Nobid)))
End With
' Option 1: Set Pivot Cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, PvtRng)
' Option 2: Set Pivot Cache
'Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PvtRng.Address(True, True, xlA1, True))
' create a new Pivot Table in "COMPARISON" sheet
Set PvtTbl = ws.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=ws.Range("A1"), TableName:="PivotTable1")
End Sub
Either you try this...
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Sheets("ARRANGED BIDS").Range(Cells(2, 1), Cells(Finalrow, (7 + 2 * Nobid))), Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="COMPARISON!A1", TableName:="PivotTable1"
Or try it like this...
Dim pc As PivotCache
Dim pt As PivotTable
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Sheets("ARRANGED BIDS").Range(Cells(2, 1), Cells(Finalrow, (7 + 2 * Nobid))), Version:=xlPivotTableVersion15)
Set pt = pc.CreatePivotTable(TableDestination:="COMPARISON!A1", TableName:="PivotTable1")
if you want to create a pivot, here is what i use. Remove all the "xl." from code, i was creating them on new excel and saved them.
Dim wb As Workbook
Dim ws As Worksheet
Dim rng1 As Range
Set wb = xl.ActiveWorkbook
Set ws = wb.Sheets("Data")
Set rng1 = ws.Cells.Find("*", ws.[a1], xlFormulas, , , xlPrevious)
xl.Worksheets.Add
xl.ActiveSheet.Name = "Pivot"
xl.Worksheets("Pivot").Activate
xl.ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Data!R1C1:R" & CStr(rng1.Row) & "C" & CStr(rng1.Column), Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivot!R3C1", TableName:="PivotTable3", DefaultVersion _
:=xlPivotTableVersion15
xl.Sheets("Pivot").Select
xl.ActiveWorkbook.ShowPivotTableFieldList = True
With xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("IC Status")
.Orientation = xlRowField
.Position = 1
End With
With xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("CompCode")
.Orientation = xlRowField
.Position = 2
End With
With xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("Aging from last action in PD")
.Orientation = xlColumnField
.Position = 1
End With
With xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("PD#")
.Orientation = xlDataField
.Position = 1
.Function = xlCount
.NumberFormat = "0"
.Name = "Count of PD#"
End With
xl.ActiveSheet.PivotTables("PivotTable3").HasAutoFormat = False
Dim j As Variant
xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("IC Status"). _
EnableMultiplePageItems = True
With xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("IC Status")
For j = 1 To .PivotItems.Count
DoEvents
.PivotItems(.PivotItems(j).Name).Visible = False
With xl.ActiveSheet.PivotTables("PivotTable3").PivotFields("IC Status")
On Error Resume Next
.PivotItems("In progress AP Timisoara").Visible = True
End With
Next j
End With