Pivot Table VBA

[tedholly]

I am attempting to create a code to create a pivot table on another sheet in my workbook. I am new to VBA and have been using online resources to help me piece this together.

The data sheet is Sheet 1 titled T&E

I want to run a code that will take the data from Sheet 1 (which is in a table) and put it into a new worksheet titled "Pivot Table"
I wan to create two separate pivot tables, with the attached criteria.

The first Pivot Table will be in Cell A1 and B1 on the new Sheet
The second Pivot Table will be in Cell D1 and E1

Any advice would be much appreciated.

Option Explicit

Dim wb As Workbook
Dim wsSheet1 As Worksheet, wsPT As Worksheet

Sub create_piviot_table()
Dim lastrow As Long, lastcolumn As Long
Dim datarange As Range
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim pvtfield As PivotFields


Set wb = ThisWorkbook
Set wsSheet1 = ThisWorkbook.Worksheets("T&E")

Call delete_PT_Sheet

With wsSheet1
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
lastcolumn = .Cells(1, Columns.Count).End(xlToLeft).Column

Set datarange = .Range(.Cells(1, 1), .Cells(lastrow, lastcolumn))

Set wsPT = wb.Worksheets.Add
wsPT.Name = "Pivot Table"

Set PTCache = wb.PivotCaches.Create(xlDatabase, datarange)

Set PT = PTCache.CreatePivotTable(wsPT.Range("A1"), "PT_Audit")
With PT

'//Pivot Table Layout Settings
.RowAxisLayout xlTabularRow
.ColumnGrand = True
.RowGrand = False
.TableStyle2 = "pivotstylemedium9"
.HasAutoFormat = False
.SubtotalLocation xlAtBottom
End With

'Row Section
With .PivotFields("Person")
.Orientation = xlRowField
.Position = 1
End With
'Values Section
With .PivotFields("Project Number")
.Orientation = xlRowField
.Position = 2
.Function = xlCount
End With


'//releasing object memories
Set PTCache = Nothing
Set wsPT = Nothing
Set wsSheet1 = Nothing
Set wb = Nothing



End With
End Sub

Private Sub delete_PT_Sheet()

On Error Resume Next
Application.DisplayAlerts = False
wb.Worksheets("Pivot Table").Delete
Application.DisplayAlerts = True


End Sub

 

[JackDanIce]

Why recreate the pivot tables each time, why not just refresh the data if you're using the same fields and aggregations?

 

[tedholly]

Why recreate the pivot tables each time, why not just refresh the data if you're using the same fields and aggregations?

Because I have separate reports from a different excel sheet pulling data from each of the pivot tables.

This workbook gets updated weekly with new data.

 

[JackDanIce]

Seems over complicated, could use Power Query to output the reports to those separate files, reduce amount of VBA code as well.

Not clear what the actual problem is but guessing the code doesn't work, make a copy of your workbook and then replace all of your code with below and try:

Sub Create_Pivot_Table()
                
    Const sPT As String = "Pivot Table"
        
    Reset_PT_Sheet sPT
    
    With Grab_Data_Cache(ThisWorkbook.Sheets("T&E")).CreatePivotTable(Sheets(sPT).Cells(1, 1), "PT_Audit")
        '//Pivot Table Layout Settings
        .RowAxisLayout xlTabularRow
        .ColumnGrand = True
        .RowGrand = False
        .TableStyle2 = "pivotstylemedium9"
        .HasAutoFormat = False
        .SubtotalLocation xlAtBottom
        
        'Row Section
        With .PivotFields("Person")
            .Orientation = xlRowField
            .Position = 1
        End With
        
        'Values Section
        With .PivotFields("Project Number")
            .Orientation = xlRowField
            .Position = 2
            .Function = xlCount
        End With
        
    End With
    
End Sub

Private Sub Reset_PT_Sheet(sName As String)
    
    On Error Resume Next
    With Application
        .DisplayAlerts = False
        .Sheets(sName).Delete
        .DisplayAlerts = True
    End With
    On Error GoTo 0
    Sheets.Add.Name = sName

End Sub

Private Function Grab_Data_Cache(w As Worksheet) As PivotCache
    
    Dim x As Long
    Dim y As Long
    
    With w
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set Grab_Data_Cache = ThisWorkbook.PivotCaches.Create(xlDatabase, .Cells(1, 1).Resize(x, y))
    End With

End Function