Welcome to FreeSoftwareServers Confluence Wiki

This requires two functions and the main sub. It will delete the Pivot Table if it exists.

Func WorksheetExists:

Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

Func ExistPivot:

Public Function ExistPivot(ptName As String) As Boolean
Dim WS As Worksheet, PT As PivotTable

    ExistPivot = False
    For Each WS In ActiveWorkbook.Worksheets
        For Each PT In WS.PivotTables
            If PT.Name = ptName Then
                ExistPivot = True
                Exit Function
            End If
        Next PT
    Next WS
End Function


Sub CreatePivotTable()

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

On Error Resume Next
Application.DisplayAlerts = False
SheetExists = WorksheetExists("PivotTable")
If Not SheetExists = True Then
    Sheets.Add Before:=PSheet
    PSheet.Name = "PivotTable"
End If
Application.DisplayAlerts = True
Set PSheet = ThisWorkbook.Worksheets("PivotTable")
Set DSheet = ThisWorkbook.Worksheets("Transactions")  '''Source Data Sheet Name'''

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)

PTableExists = ExistPivot("PivotTable")
If PTableExists = True Then
'MsgBox "Deleting PTable!"
 Call DeletePivotTable("PivotTable", "PivotTable")
End If

Set PCache = ThisWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _

Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

With PSheet.PivotTables("PivotTable").PivotFields("Date")
.Orientation = xlRowField
.Position = 1
.AutoSort xlDescending, "Received"
End With

With PSheet.PivotTables("PivotTable").PivotFields("Amount")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
End With

End Sub
  • No labels