VBA - Module Pivot loopt vast

[RaymondC]

Goedemorgen,

De onderstaande code heb ik gebruikt om een pivot table te maken.
Echter loopt deze nu vast op:

Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("C3"), TableName:="PivotTable1")

Wat moet er aangepast worden?

Sub Create_PivotComplaint()

Dim PCache As PivotCache, LastRow As Long, pt As PivotTable

  'If "Pivot" worksheet already exists, delete it

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


 Worksheets("Overview Complaints").Activate
 Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
     Worksheets.Add
    ActiveSheet.Name = "Pivot_Complaints"
    ActiveWindow.DisplayGridlines = False
 Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("C3"), TableName:="PivotTable1")

 

[edmoor]

"Loopt vast" zegt niks over de oorzaak.
Wellicht ook handig om er bij te vertellen welke foutmelding je krijgt.

 

[RaymondC]

Sorry, dat niet duidelijke omschrijving van probleem is.

Heb het ondertussen opgelost, met onderstaande code (gevonden op internet)

Sub Create_Pivot_Warning()

Dim PTable As PivotTable
Dim PCache As PivotCache
Dim PRange As Range
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim LR As Long
Dim LC As Long

On Error Resume Next

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets("Vendor_Pivot").Delete 'This will delete the exisiting pivot table worksheet
Worksheets.Add After:=ActiveSheet ' This will add new worksheet
ActiveSheet.Name = "Vendor_Pivot" ' This will rename the worksheet as "Vendor_Pivot"
On Error GoTo 0

Set PSheet = Worksheets("Vendor_Pivot")
Set DSheet = Worksheets("Overview Complaints")

'Find Last used row and column in data sheet
LR = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LC = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column

'Set the pivot table data range
Set PRange = DSheet.Cells(1, 1).Resize(LR, LC)

'Set pivot cahe
Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=PRange)

'Create blank pivot table
Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(3, 3), TableName:="01Vendor_Report")

ActiveWindow.DisplayGridlines = False
        
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("01Vendor_Report").PivotFields("Vendor")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("01Vendor_Report").AddDataField ActiveSheet.PivotTables( _
        "01Vendor_Report").PivotFields("Complaint ID"), "Count of Complaint ID", _
        xlCount
    
    With ActiveSheet.PivotTables("01Vendor_Report").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("01Vendor_Report").PivotFields("Year")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    'ActiveSheet.PivotTables("01Vendor_Report").PivotFields("Vendor").AutoSort
     '   xlAscending , "Vendor"
    'ActiveWindow.SmallScroll Down:=-6


     ActiveWorkbook.ShowPivotTableFieldList = True
    
 
     ActiveWindow.FreezePanes = False
     
     Columns("C:AA").EntireColumn.AutoFit
     MsgBox "The macro has finished running.", vbInformation
 
 End Sub