expfresocspy
01-25-2012, 07:09 PM
I have over 14 thousands of data to go through and I'm currently working on the automated creation of pivot tables . This is the code that I'm using now :
Sub managementPT()
Dim WSD As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim finalRow As Long
Dim FinalCol As Long
Set WSD = Worksheets("Management Data")
'Delete any prior pivot tables
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT
'Define input area and set up a Pivot Cache
finalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Columns.Count). _
End(xlToLeft).Column
Set PRange = WSD.Cells(1, 1).Resize(finalRow, FinalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add _
(SourceType:=xlDatabase, SourceData:="'Management Data'!" & PRange.Address(ReferenceStyle:=xlR1C1))
'Create Pivot 1 table for the [cells 30,2] table
'Create the Pivot Table from the Pivot Cache on to another worksheet
Set PT = PTCache.CreatePivotTable(TableDestination:=Cells(30,2), TableName:="PivotTable01")
'Set a Pivot Table variable to our new Pivot Table
Set PT = ActiveSheet.PivotTables("PivotTable01")
'Place the Pivot Table to Start from A3 on the new sheet
'Turn off updating while building the table
PT.ManualUpdate = True
'Set up the row & column fields
PT.AddFields PageFields:=Array("Status", "Month Submitted")
'Set up the data fields
With PT.PivotFields("Number")
.Orientation = xlDataField
.Function = xlCount
.Position = 1
End With
' Ensure that you get zeroes instead of blanks in the data area
PT.NullString = "0"
' Make sure all PivotItems along line are visible
For Each PivItem In _
PT.PivotFields("Status").PivotItems
PivItem.Visible = True
Next PivItem
' Now - loop through and keep only certain items visible
For Each PivItem In _
PT.PivotFields("Status").PivotItems
Select Case PivItem.Name
Case "Normal"
PivItem.Visible = True
Case Else
PivItem.Visible = False
End Select
Next PivItem
'Calc the pivot table
PT.ManualUpdate = False
PT.ManualUpdate = True
End Sub
Then I have an error "Method 'CreatePivotTable' of object 'PivotCache' failed" on the code : Set PT = PTCache.CreatePivotTable(TableDestination:=Cells(30, 2), TableName:="PivotTable01")
What can I do to solve this error ? Please help me )': :(
Sub managementPT()
Dim WSD As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim finalRow As Long
Dim FinalCol As Long
Set WSD = Worksheets("Management Data")
'Delete any prior pivot tables
For Each PT In WSD.PivotTables
PT.TableRange2.Clear
Next PT
'Define input area and set up a Pivot Cache
finalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
FinalCol = WSD.Cells(1, Columns.Count). _
End(xlToLeft).Column
Set PRange = WSD.Cells(1, 1).Resize(finalRow, FinalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add _
(SourceType:=xlDatabase, SourceData:="'Management Data'!" & PRange.Address(ReferenceStyle:=xlR1C1))
'Create Pivot 1 table for the [cells 30,2] table
'Create the Pivot Table from the Pivot Cache on to another worksheet
Set PT = PTCache.CreatePivotTable(TableDestination:=Cells(30,2), TableName:="PivotTable01")
'Set a Pivot Table variable to our new Pivot Table
Set PT = ActiveSheet.PivotTables("PivotTable01")
'Place the Pivot Table to Start from A3 on the new sheet
'Turn off updating while building the table
PT.ManualUpdate = True
'Set up the row & column fields
PT.AddFields PageFields:=Array("Status", "Month Submitted")
'Set up the data fields
With PT.PivotFields("Number")
.Orientation = xlDataField
.Function = xlCount
.Position = 1
End With
' Ensure that you get zeroes instead of blanks in the data area
PT.NullString = "0"
' Make sure all PivotItems along line are visible
For Each PivItem In _
PT.PivotFields("Status").PivotItems
PivItem.Visible = True
Next PivItem
' Now - loop through and keep only certain items visible
For Each PivItem In _
PT.PivotFields("Status").PivotItems
Select Case PivItem.Name
Case "Normal"
PivItem.Visible = True
Case Else
PivItem.Visible = False
End Select
Next PivItem
'Calc the pivot table
PT.ManualUpdate = False
PT.ManualUpdate = True
End Sub
Then I have an error "Method 'CreatePivotTable' of object 'PivotCache' failed" on the code : Set PT = PTCache.CreatePivotTable(TableDestination:=Cells(30, 2), TableName:="PivotTable01")
What can I do to solve this error ? Please help me )': :(