How to increase the speed of the macro.

[Jagdev Singh]

Hi Experts.

I am currently using the below code to create a pivot table and the amount of entries in the RAW data is around 95k. I am happy with the outcome, but the only issue is with the amount of time it takes for the macro to run and reflect the output. I measure the time and it takes more than 5 mins to complete the task.

Is there a way we can reduce this time.

Sub CreatePivotTable()
Dim PvtTbl As PivotTable
Dim wsData As Worksheet
Dim pivotrng As Range
Dim lrow As Long, lCol As Long
Dim wsPvtTbl As Worksheet
Application.ScreenUpdating = False
'Worksheet which contains the source data
Set wsData = Worksheets("Data")
'Worksheet where the new PivotTable will be created
Set wsPvtTbl = Worksheets("Pivot")
'delete all existing Pivot Tables in the worksheet
'in the TableRange1 property, page fields are excluded; to select the entire PivotTable report, including the page fields, use the TableRange2 property.
For Each PvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable!", vbYesNo) = vbYes Then
PvtTbl.TableRange2.Clear
End If
Next PvtTbl
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Data!R1C1:R" & LastRow & "C" & LastCol, Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Pivot!R6C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Pivot").Select
Cells(3, 1).Select

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Organisation name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Created Date")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("UWSettDueDate")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Posting Ref")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Insured")
.Orientation = xlRowField
.Position = 5
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Business Unit")
.Orientation = xlRowField
.Position = 6
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("PrioritySettType")
.Orientation = xlRowField
.Position = 7
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Internal Notes")
.Orientation = xlRowField
.Position = 8
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("Ledger Amount GBP"), "Sum of Ledger Amount GBP", _
xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Assigned Handler")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Transaction Type")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("AgeBandBasedNextMonthEndDate")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("LedgerTransBreakdownStatus")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Within 60 days?")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
ActiveWorkbook.ShowPivotTableFieldList = False

ActiveSheet.PivotTables("PivotTable1").PivotFields("Organisation name"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Created Date").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)

ActiveSheet.PivotTables("PivotTable1").PivotFields("UWSettDueDate").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)

ActiveSheet.PivotTables("PivotTable1").PivotFields("Posting Ref").Subtotals = _
Array(False, False, False, False, False, False, False, False, False, False, False, False)

ActiveSheet.PivotTables("PivotTable1").PivotFields("Insured").Subtotals = Array _
(False, False, False, False, False, False, False, False, False, False, False, False)

ActiveSheet.PivotTables("PivotTable1").PivotFields("PrioritySettType"). _
Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
False, False)

ActiveSheet.PivotTables("PivotTable1").PivotFields("Internal Notes").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)
ActiveSheet.PivotTables("PivotTable1").PivotFields("Business Unit").Subtotals _
= Array(False, False, False, False, False, False, False, False, False, False, False, False _
)

ActiveWindow.Zoom = 90
Columns("A:A").ColumnWidth = 30
Columns("D:D").ColumnWidth = 23.29
Columns("E:E").ColumnWidth = 20.86
Columns("F:F").ColumnWidth = 19.43
Columns("G:G").ColumnWidth = 30
Columns("H:H").ColumnWidth = 30

ActiveSheet.PivotTables("PivotTable1").PivotSelect "'Internal Notes'[All]", _
xlLabelOnly, True
Range("D7").Select

Columns("H:H").Select
Selection.Style = "Comma"
Columns("I:I").Select
Selection.Style = "Comma"

Application.ScreenUpdating = True
End Sub

 

[Asheesh]

Hi Jagdev -

Go through the link below

http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm

This link has lots of tips & techniques which you can incorporate in the aforesaid codes to optimize them.

Hope this helps..

 

[jeffreyweir]

Before you make any changes to the PivotTable, do this:
ActiveSheet.PivotTables("PivotTable1").ManualUpdate = TRUE

...and then after you've made all the changes, do this:

ActiveSheet.PivotTables("PivotTable1").ManualUpdate = FALSE

That will stop the PivotTable recalculating every time you make a change to it. That should dramatically reduce the time it takes this code to execute.


Also, instead of using this all the time:
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Organisation name")

...do something like this:
With ActiveSheet.PivotTables("PivotTable1")
with .PivotFields("Organisation name")
'code here
end with
with .PivotFields("Created Date")
'code here
end with
with .PivotFields(....)
'code here
end with



End With

 

[Jagdev Singh]

Hi Jeff

This is fantastic...It reduced the time drastically from 5mins to 1mins..

Thanks a lot!

Regards,
Jaggi