Pivot Table error whilecreating using VBA

Question

Good mrng!

I am trying to create pivot table using vba and i am very new to pivot using vba and i tried to research in google as much as possible to get this corrected but didnt find much info which can help me to fix it, would be of great help if anyone can help me with this.

Range - always starts from A10, columns will be fixed until H but number of rows are not fixed hence i tried to define the range and use it in the code but its throwing me below error message, please check and correct me

Issues faced-Not able to define Rng as Range and not able to use this range in the pivot table.

Rng as Range

Run time error '91': Object variable or with black variance not set

Pivot cache

Run Time error '438': Object doesn't support this property or method

Data

ACT AN Currency CB LC Type CB FC Type SI 1001 c USD 2,031 Dr 2,031 Dr 0005
1002 a BHD 1,194 Dr 1,194 Dr 0105
1003 P EUR 326 Dr 326 Dr 0110
1004 AR GBP 60,467 Dr 60,467 Dr 0125
1005 AP DHS (73,080) Cr (73,080) Cr 0190

Sub Pivot()

Dim ws As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
'Dim Rng As Range

'Defining Range

Rng = Range("A10").Select
Rng = Range(Selection, Selection.End(xlToRight)).Select
Rng = Range(Selection, Selection.End(xlDown)).Select



'Adding new worksheet
Set ws = Worksheets.Add
'Creating Pivot cache
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Working!Rng").Select


'Creating Pivot table
Set pt = pc.CreatePivotTable(ws.Range("B3"))
'Setting Fields
With pt
'set row field
With .PivotFields("SI")
.Orientation = xlRowField
.Position = 1
End With
'set column field
With .PivotFields("Currency")
.Orientation = xlColumnField
.Position = 1
End With

End With

End Sub

Thanks for your help!

Regards Suresh7860

Answer 1

Try and use the below code as a sample for what you need. If anything is unclear I will be happy to answer. But you won't learn if I write the code for you.

Sub BuildPT()

    Dim pvtTbl As PivotTable
    Dim pvtCha As PivotCache
    Dim pvtDestWS As Worksheet
    Dim pvtSrcWS As Worksheet
    Dim pvtWB As Workbook
    Dim pvtSrcRng As Range
    Dim pvtStrt As Range
    Dim keyRng As Range
    Dim LastRow As Integer
    Dim LastCol As Integer

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual      

    On Error Resume Next
        pvtWB.Worksheets("Total").Delete 'Delete PT destination sheet
    On Error GoTo 0

    Set pvtSrcWS = pvtWB.Worksheets("Data") 'Set source sheet name

    'Here I find the last row and column containing data

    LastRow = pvtSrcWS.Cells.Find(What:="*", After:=pvtSrcWS.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, MatchByte:=False).row
    LastCol = pvtSrcWS.Cells.Find(What:="*", After:=pvtSrcWS.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, MatchByte:=False).Column


    Set pvtSrcRng = Range(pvtSrcWS.Cells(1, 3), pvtSrcWS.Cells(LastRow, LastCol)) 'Set the range that contains the source data

    Set pvtDestWS = pvtWB.Sheets.Add 'Add the destination sheet
    pvtDestWS.Name = "Total" 'Rename destination sheet

    Set pvtStrt = pvtDestWS.Cells(1, 1) 'Set the PT start location

    'Here I create the pivot cache, the container that holds pivot table data
    'Then I create the pivot table itself
    Set pvtCha = pvtWB.PivotCaches.Create(xlDatabase, pvtSrcRng)
    Set pvtTbl = pvtCha.CreatePivotTable(TableDestination:=pvtStrt, TableName:="Test PT")

    'Now I add the fields I need
    With pvtTbl
        With .PivotFields("Amount")
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0"
        End With
        With .PivotFields("Account")
            .Orientation = xlPageField
            .CurrentPage = "513035"
        End With
        .PivotFields("Key").Orientation = xlRowField
        .RepeatAllLabels xlRepeatLabels
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub