We create a number of commission reports for various brokers at month end. There is standard pivot that needs to be created on the raw data and is the same for all files. I wrote a macro that copies a pivot from a template file, changes the pivot range and refreshes the data. It worked fine when I was doing 10-15 files but as number of files has grown to over a 100, it keeps crashing after processing around 14 files. I tried to fix the error but it keeps saying unable to set the Name property of the PivotTable class. Can anyone look and see what I am doing wrong?
VBA Code:
Sub CopyPivot()
On Error GoTo ErrMsg
'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
Dim PTableName As String
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFileName As String
Dim fso As FileSystemObject
Dim CommissionFolder As Folder
Dim CommissionFile As File
Dim wbFile As Workbook
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
Set fso = New FileSystemObject
Set CommissionFolder = fso.GetFolder(xStrPath)
For Each CommissionFile In CommissionFolder.Files
If CommissionFile.Name Like "*.xlsx" Then
Set wbFile = getWorkbook(xStrPath & "\" & CommissionFile.Name)
'Insert a New Blank Worksheet
Application.DisplayAlerts = False
Set PSheet = wbFile.Sheets.Add(Before:=wbFile.Sheets(1))
PSheet.Name = "Summary"
Application.DisplayAlerts = True
xFileName = Left(wbFile.Name, Len(wbFile.Name) - 5)
Set DSheet = wbFile.Sheets(xFileName)
'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 and Create Pivot Table
PTableName = "CommissionTable_" & Format(Now, "hhmmss")
Set PCache = wbFile.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), TableName:=PTableName)
'Insert Row Fields
With PTable.PivotFields("Account Name")
.Orientation = xlRowField
.Position = 1
End With
With PTable.PivotFields("Invoice Date")
.Orientation = xlRowField
.Position = 2
End With
With PTable.PivotFields("Product Name")
.Orientation = xlRowField
.Position = 3
End With
'Insert Data Fields
With PTable.PivotFields("Count")
.Orientation = xlDataField
.Function = xlSum
.Name = "Count"
End With
With PTable.PivotFields("Premium Amount")
.Orientation = xlDataField
.Function = xlSum
.Name = "Premium"
.NumberFormat = "#,###.00"
End With
With PTable.PivotFields("Commission Amount")
.Orientation = xlDataField
.Function = xlSum
.Name = "Commission"
.NumberFormat = "#,###.00"
End With
'Format Pivot Table
PTable.RowAxisLayout xlTabularRow
PTable.ShowValuesRow = False
PTable.TableRange1.Columns.AutoFit
wbFile.Close True
End If
Next
ErrMsg:
MsgBox Err.Description
End Sub
Private Function getWorkbook(FullFilename As String) As Workbook
Dim wb As Workbook
Set wb = Application.Workbooks.Open(FullFilename)
Set getWorkbook = wb
End Function
Last edited by a moderator:
