faster vba code for creating a pivot

[Monicasinha]

Can there be an alternate vba code for creating pivot which is faster. Here is the code I have with me:

Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable

FileToOpen = Application.GetOpenFilename(filefilter:="Excelfiles(*.xlsb),*xlsx*")
Set Openbook = Application.Workbooks.Open(FileToOpen)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Set PSheet = Openbook.Sheets.Add(Before:=Openbook.ActiveSheet)

PSheet.Name = "PivotTable"

Set PRange = DSheet.Range(DSheet.Cells(1, 1), DSheet.Cells(LastRow, LastCol1)).CurrentRegion

Set PCache = ActiveWorkbook.PivotCaches.Create _

(SourceType:=xlDatabase, SourceData:=PRange)

Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:="Pivot1")



With PTable.PivotFields("Category")

.Orientation = xlPageField

.Position = 1

.ClearAllFilters

.CurrentPage = "Resource"

End With

With PTable

.PivotFields("A").Orientation = xlRowField

.PivotFields("A").Position = 1

.PivotFields("D").Orientation = xlRowField

.PivotFields("D").Position = 2

.PivotFields("Apple").Orientation = xlRowField

.PivotFields("Apple").Position = 3

.PivotFields("C").Orientation = xlRowField

.PivotFields("C").Position = 4

.PivotFields("CT").Orientation = xlRowField

.PivotFields("CT").Position = 5

.PivotFields("E").Orientation = xlRowField

.PivotFields("E").Position = 6

.PivotFields("CAR").Orientation = xlRowField

.PivotFields("CAR").Position = 7

End With

PTable.AddDataField PSheet.PivotTables( _

"Pivot1").PivotFields("Total"), "Sum of Total", xlSum

With PTable.PivotFields("Type")

.Orientation = xlColumnField

.Position = 1

End With

PTable.RowAxisLayout xlTabularRow





With PTable

For Each PField In .PivotFields

PField.Subtotals(1) = True

PField.Subtotals(1) = False

Next PField

End With



AppleArray = Array("Red", "Yellow", "Green")

With PTable.PivotFields("Apple")

For i = 1 To .PivotItems.Count

If IsError(Application.Match(.PivotItems(i).Name, SGArray, 0)) Then

.PivotItems(i).Visible = False

Else

.PivotItems(i).Visible = True

End If

Next i

End With



TypeArray = Array("Billable Hours", "Revenue Recognition")

With PTable.PivotFields("Type")

For i = 1 To .PivotItems.Count

If IsError(Application.Match(.PivotItems(i).Name, TypeArray, 0)) Then

.PivotItems(i).Visible = False

Else

.PivotItems(i).Visible = True

End If

Next i

End With

Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub
PTable.RepeatAllLabels xlRepeatLabels

PTable.ColumnGrand = False

PTable.RowGrand = False

 

[James006]

Hi,

Can you provide us with your own definition of Faster ...?

 

[Monicasinha]

At present this code takes more than a minutes. Can it be done within seconds?

 

[James006]

It all hinges on how large is your Database ...?

Instead of going through the whole process each and every time ...

Have you tried to just Refresh your Pivot Table whenever data is modified ?

 

[Monicasinha]

No, the vba code actually creates a new pivot from a flat file with the given formatting. The flat file keeps changing. For every new file, pivot needs to be created and then data from there needs to be copied and pasted in another file.

 

[Monicasinha]

Anyone has any solution here?