Excel Vba to create pivot tables

[Biz]

Dear All,

I am trying to create a Pivot using Excel VBA using CreatePivot vba.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
It is failing at adding Datafields.<o></o>

Sub CreatePivot()
    Dim wsTarget As Worksheet
    Dim wsDestination As Worksheet
    Dim vrnPC As PivotCache
    Dim vrnPT As PivotTable
    Dim vrnWS As Worksheet
    Set vrnWS = ActiveSheet
    Dim vrnRng As Range
    Dim finalRow As Long, finalCol As Long
    
    Set wsTarget = Sheets("Adj")
    Set wsDestination = Sheets("Pivot")
    
    
    wsTarget.Activate
    finalRow = Cells(Rows.Count, "A").End(xlUp).Row
    finalCol = Cells(9, 256).End(xlToLeft).Column
    Set vrnRng = wsTarget.Cells(1, 1).Resize(finalRow, finalCol).Offset(8, 0)
    
    vrnRng.Select 'Test Range
    
    wsDestination.Activate
    Cells.Delete Shift:=xlUp ' Delete Previous Pivot table
  
     'Create pivot table Cache from the table
    Set vrnPC = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
                        SourceData:=vrnRng)
    
      
    'Create pivot table
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=vrnRng, _
        Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=wsDestination.Range("A3"), TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion10
    
    'Create Pivot Table filters xlPageField
    With wsDestination.PivotTables("PivotTable1").PivotFields("List")
        .Orientation = xlPageField
        .Position = 1
        .PivotItems("").Visible = False
    End With
    
    'Create Row Label
    With wsDestination.PivotTables("PivotTable1").PivotFields("Class")
        .Orientation = xlRowField
        .Position = 1
        .PivotItems("(blank)").Visible = False
    End With
    
    'Add Datafields
    With wsDestination.PivotTables("PivotTable1")
        .AddDataField.PivotFields ("Revenue"), "Sum of Revenue", .Function = xlSum
        .AddDataField.PivotFields ("Repairs & Maintenance"), "Sum of Repairs & Maintenance", .Function = xlSum
        .AddDataField.PivotFields ("Fuel"), "Sum of Fuel", .Function = xlSum
        .AddDataField.PivotFields ("Other"), "Sum of Other", .Function = xlSum
        .AddDataField.PivotFields ("Licence & Tax"), "Sum of Licence & Tax", .Function = xlSum
        .AddDataField.PivotFields ("Leased Costs"), "Sum of Leased Costs", .Function = xlSum
        .AddDataField.PivotFields ("Depreciation"), "Sum of Depreciation", .Function = xlSum
        .AddDataField.PivotFields ("Total Expenses"), "Sum of Total Expenses", .Function = xlSum
        .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
    End With
    
End Sub

Your help would be appreciated.

Biz<o></o>

 

[Sektor]

With wsDestination.PivotFields ("Revenue")
    .Orientation = xlDataField
    .Function = xlSum
    .NumberFormat = "#,0"
    .Caption = "Sum of Revenue"
End With

 

[RoryA]

You are missing spaces between the .AddDataField and the .PivotFields:

.AddDataField .PivotFields("Revenue"), "Sum of Revenue", .Function = xlSum

 

[Biz]

Hi Rorya,
I tried but it did not work.

Biz

 

[Biz]

Hi Sektor,

I want to create multiple xlDatafields. Is it possible?

Biz

 

[RoryA]

Always need more information than "did not work".

 

[Biz]

Hi Rorya,

I figured it out finally. Posting this code as it may benefit someone else.

Sub CreatePivot()
    Dim wsTarget As Worksheet
    Dim wsDestination As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim FinalCol As Long
    
    Set wsTarget = Sheets("Adj")
    Set wsDestination = Sheets("Pivot")
    
    'Delete any prior pivot tables
    For Each PT In wsDestination.PivotTables
        PT.TableRange2.Clear
    Next PT
    
    'Define input area and set up a Pivot Cache
    FinalRow = wsTarget.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = wsTarget.Cells(9, Application.Columns.Count).End(xlToLeft).Column
    Set PRange = wsTarget.Cells(1, 1).Resize(FinalRow, FinalCol).Offset(8, 0)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=PRange)
    
    'Create the pivot table
    Set PT = PTCache.CreatePivotTable(TableDestination:=wsDestination.Cells(3, 1), _
        TableName:="PivotTable1")
    
    '**** Define the layout of the pivot table****
    ' Set update to manual to avoid recomputation while laying out
    PT.ManualUpdate = True
    
    'Set up the row & column fields
    PT.AddFields RowFields:=Array("Class")
    ', ColumnFields:="Region"
    'Pt.AddFields DataField:=Array("Revenue"),
    
    '--------- Array to Create Xl Data Fields------------
    Dim i As Long, j As Long
    Dim aArray() As String: aArray = Split("Revenue,Repairs & Maintenance,Fuel,Other,Licence & Tax,Leased Costs,Depreciation,Total Expenses", ",")
    j = 1
    For i = 0 To 7
        With PT.PivotFields(aArray(i))
            .Orientation = xlDataField
            .Function = xlSum
            .Position = j
            .NumberFormat = "#,##0.00_);[Red](#,##0.00)"
        End With
        j = j + 1
        Debug.Print (aArray(i))
    Next i
    Erase aArray() ' deletes the varible contents, free some memory
    '--------------------------------------------------------------
    
    'Change Orientation Column Field
    With PT.DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    'Create xlPageField Filters
    With PT.PivotFields("List")
        .Orientation = xlPageField
        .Position = 1
        .PivotItems("").Visible = False
        .PivotItems("(blank)").Visible = False
    End With
    
    'Calc the pivot table
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    
    'Remove from Memory
    Set wsTarget = Nothing
    Set wsDestination = Nothing
    Set PRange = Nothing
    Set PTCache = Nothing
    Set PT = Nothing
    
End Sub

Biz