0
\$\begingroup\$

I have created a VBA macro to create a pivot table automatically. But taking 15 to 20 minutes of time to complete the macro.

Especially at the point of below code taking half of the time. Review Code below

With .PivotFields("NTS USD ACT Previous Year")
    .Orientation = xlDataField
    .Position = 1
    .Function = xlAverage
    .NumberFormat = "$#,##;($#,##);-"
    .Caption = "FG NTS PY-Average"
End With

Requirements:

Pivot Table should be in Tabular Format. Grand Total should be there and when I filter for single "JNJ RM Code" Grand should change. Row Sub totals should be turned off. Repeat all data labels. Adjust Pivot table Column width Seeking Advice: Can I have 200,000 data on excel sheet and to use pivot.

Please do suggest how much data maximum excel can hold with better performance.

Please review the entire module for your reference.

Option Explicit

Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet

Sub Create_Pivot_Table()
Dim LR As Long, LC As Byte
Dim DataRange As Range
Dim PTCache As PivotCache
Dim pt As PivotTable
Dim st As String
st = Now()

Set wb = ThisWorkbook
Set wsData = wb.Worksheets("Data")

Call Delete_PT_Sheet

With wsData
LR = .Cells(Rows.Count, "A").End(xlUp).Row
LC = .Cells(1, Columns.Count).End(xlToLeft).Column

Set DataRange = .Range(.Cells(1, 1), .Cells(LR, LC))

Set wsPT = wb.Worksheets.Add

wsPT.Name = "Pivot_Data"

Set PTCache = wb.PivotCaches.Create(xlDatabase, DataRange)
Set pt = PTCache.CreatePivotTable(wsPT.Range("A2"), "Data")

    With pt
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .VisualTotals = False
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = True
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = True
        .SortUsingCustomLists = True
        .DisplayImmediateItems = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .RowAxisLayout xlTabularRow
        .RepeatAllLabels xlRepeatLabels

        '// Filter(s)
        With .PivotFields("Region")
            .Orientation = xlPageField
            .EnableMultiplePageItems = True
            .Subtotals(1) = True
            .Subtotals(1) = False
        End With
        
        '// Row Section (Layer 1)
        With .PivotFields("JNJ RM Code")
            .Orientation = xlRowField
            .Position = 1
            .LayoutBlankLine = False
            
            .Subtotals(1) = True
            .Subtotals(1) = False
            .LayoutForm = xlTabular 'xlOutline
            .LayoutCompactRow = True
        End With
        
        '// Row Section (Layer 2)
        With .PivotFields("Component Description")
            .Orientation = xlRowField
            .Position = 2
            .LayoutBlankLine = False
            .Subtotals(1) = True
            .Subtotals(1) = False
        End With
                
        '// Row Section (Layer 3)
        With .PivotFields("FG Material Code")
            .Orientation = xlRowField
            .Position = 3
            .LayoutBlankLine = False
            .Subtotals(1) = True
            .Subtotals(1) = False
        End With
         
        '// Row Section (Layer 4)
        With .PivotFields("FG Material Description")
            .Orientation = xlRowField
            .Position = 4
            .LayoutBlankLine = False
            .Subtotals(1) = True
            .Subtotals(1) = False
        End With
        
        '// Values Section Layer 2)
        With .PivotFields("NTS USD ACT Previous Year")
            .Orientation = xlDataField
            .Position = 1
            .Function = xlAverage
            .NumberFormat = "$#,##;($#,##);-"
            .Caption = "FG NTS PY-Average"
        End With
    
    End With 'PT

End With 'wsData


'//Releasing Object Memories
Set PTCache = Nothing
Set wsPT = Nothing
Set DataRange = Nothing
Set wsData = Nothing
Set wb = Nothing

ThisWorkbook.Save

'MsgBox ("Completed")

End Sub
\$\endgroup\$
8
  • \$\begingroup\$ The line(s) With .PivotFields ... End With are taking 7-10 minutes to execute? My guess is that it's in .Function = xlAverage and it will probably take this long if you were to create the pivot by hand. Since that's a built in Excel function, there isn't much you can do about that. \$\endgroup\$
    – FreeMan
    Sep 24 '21 at 15:13
  • \$\begingroup\$ Can you have 200,000 rows of data in Excel? Sure! You can have 1 million rows (I believe that's the max for Excel 2010 and newer). It's just going to take longer to get things done. You may be at the point where it's time to migrate your data set into an actual database instead of using Excel as a database server (which it isn't very good at). \$\endgroup\$
    – FreeMan
    Sep 24 '21 at 15:44
  • \$\begingroup\$ Did you remember to turn off the display of the work sheet while the pivot table is being created? If the display is being updated while processing the data the entire process is slowed down. \$\endgroup\$
    – pacmaninbw
    Sep 24 '21 at 16:29
  • \$\begingroup\$ @FreeMan Thank you for your reply. I noticed that when pivot did manually it is a bit faster than automation, \$\endgroup\$
    – Mani233
    Sep 26 '21 at 16:56
  • \$\begingroup\$ @FreeMan in that case can I use MS Access Automation to get this done? if yes is there any way to replicate data same as like pivot table? \$\endgroup\$
    – Mani233
    Sep 26 '21 at 17:00

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.