1
votes

I'm trying to create a top 10 value with the pivot table created with excel vba but it seems like I'm getting an error

Run-time Error '1004':

Application-defined or object defined error

Here is the code, I can't seems to find the problem after I search through the internet

Sub PivotGenerate()

'declaration
Dim sht As Worksheet
Dim pvt As PivotTable
Dim pvtFld As PivotField
Dim pvtCache As PivotCache
Dim StartPvt As String
Dim SrcData As String
Dim RangeInput As Range

'Input value
Set RangeInput = Application.InputBox(Prompt:= _
        "Please Select Name range", _
        Title:="InputBox Method", Type:=8)

'Stop Updating
Application.ScreenUpdating = False

'data range for pivot
SrcData = ActiveSheet.Name & "!" & RangeInput.Address(ReferenceStyle:=xlR1C1)

'error handling for new worksheet
Application.DisplayAlerts = False

On Error Resume Next
ThisWorkbook.Sheets("PivotTable").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'create new worksheet
Set sht = Worksheets.Add(After:=Sheets(Worksheets.Count))
sht.Name = "PivotTable"

'Pivot Table location
StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SrcData)

'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable(TableDestination:=StartPvt, TableName:="Top 10 Commitment Value")

'Set active
Set pvt = ActiveSheet.PivotTables("Top 10 Commitment Value")

'Classic View
pvt.InGridDropZones = True
pvt.RowAxisLayout xlTabularRow

'Remove Subtotal
With pvt
   For Each pvtFld In .PivotFields
   pvtFld.Subtotals(1) = False
Next pvtFld
End With

'Row Labels
pvt.PivotFields("CUST Name").Orientation = xlRowField
pvt.PivotFields("CUST Name").Position = 1

'Data Value
pvt.AddDataField pvt.PivotFields("Commitment RM"), "Sum of Commitment RM", xlSum
pvt.AddDataField pvt.PivotFields("OS BALANCE RM (On BS)"), "Sum of OS BALANCE RM (On BS)", xlSum

pvt.PivotFields("CUST Name").AutoShow Type:=xlAutomatic, Range:=xlTop, Count:=5, Field:="Sum of Commitment RM"


'Activate Updating
Application.ScreenUpdating = True

End Sub

The debugging highlighted this line in the code

pvt.PivotFields("CUST Name").AutoShow Type:=xlAutomatic, Range:=xlTop, Count:=5, Field:="Sum of Commitment RM"

The Pivot Table is manage to be generated but the Top 10 line gave error

1
According to the help:"Field: The name of the base data field. You must specify the unique name (as returned from the SourceName property), and not the displayed name." So, get rid of the "Sum of " and just use the field name.Doug Glancy
Thanks for the reply, After removing the "Sum of" the same error occur still. Any other advice?Nelson Nshdx
Sorry, no. If there really is a data field whose source is "Commitment RM" then my comment obviously doesn't apply. Beyond that I don't have experience with the AutoShow function. What you've got sure looks like it should work. Have you tried turning on the Macro Recorder and looking at the generated code when you select the top 5?Doug Glancy
Thanks for the help, This is what I get from the Macro Recorder ActiveSheet.PivotTables("PivotTableTop10").PivotFields("CUST NAME"). _ PivotFilters.Add2 Type:=xlTopCount, DataField:=ActiveSheet.PivotTables( _ "PivotTableTop10").PivotFields("Sum of Commitment RM"), Value1:=10Nelson Nshdx
That's different! Glad it worked for you.Doug Glancy

1 Answers

1
votes

Thanks for the help from Doug Glancy, This is what I get from the Macro Recorder

ActiveSheet.PivotTables("PivotTableTop10").PivotFields("CUST NAME"). _ PivotFilters.Add2 Type:=xlTopCount, DataField:=ActiveSheet.PivotTables( _ "PivotTableTop10").PivotFields("Sum of Commitment RM"), Value1:=10