i have an Excel File with a sheet called "Daten". In this table are in the first column the years (2018 - 2024) an in the second column are the customers. Every row is an order. Now i want to create an VBA Makro which creates for every year a new sheet with a PivoTable that shows me how many orders every customer makes this year. The Macro i created work for the first year (A new sheet for 2018 is created and an PivoTable is inserted with the correct data. But with the second year (2019) the sheet is created but before inserting the PivoTable i get an runtime error 1004.
Screenshot of Runtime Error Msg
This is my macro:
Sub CreatePivotTables()
Dim SrcData As Range
Dim SrcSheet As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Dim i As Long
Dim YearList As Collection
Dim YearVal
' Set the variables
Set SrcSheet = ThisWorkbook.Sheets("Daten") ' Set to your source sheet name
Set YearList = New Collection
' Create a unique list of years
On Error Resume Next
FinalRow = SrcSheet.Cells(SrcSheet.Rows.count, 1).End(xlUp).Row
For i = 2 To FinalRow ' Assume row 1 has headers
YearList.Add SrcSheet.Cells(i, 1).Value, CStr(SrcSheet.Cells(i, 1).Value)
Next i
On Error GoTo 0
' Create a pivot table for each unique year
For Each YearVal In YearList
' Check if AutoFilter is on and turn off
If SrcSheet.AutoFilterMode Then
SrcSheet.AutoFilterMode = False
End If
' Apply AutoFilter
SrcSheet.Range("A1:B" & FinalRow).AutoFilter Field:=1, Criteria1:=YearVal
' SrcSheet.Cells.AutoFilter Field:=1, Criteria1:=YearVal
' Set the source data for Pivot Table
Set SrcData = SrcSheet.Range("A1:B" & FinalRow).SpecialCells(xlCellTypeVisible)
' Set SrcData = SrcSheet.UsedRange.SpecialCells(xlCellTypeVisible)
' Ausgabe der Adresse des Datenbereichs in das Direktfenster
Debug.Print "Year: " & YearVal & "; SrcData.Address: " & SrcData.Address
' ' Ausgabe der Werte des Datenbereichs
' Dim cell As Range
' For Each cell In SrcData
' Debug.Print "Cell Address: " & cell.Address & "; Value: " & cell.Value
' Next cell
' Ausgabe der ersten 10 Werte des Datenbereichs
Dim cell As Range
Dim count As Integer
count = 0
For Each cell In SrcData
Debug.Print "Cell Address: " & cell.Address & "; Value: " & cell.Value
count = count + 1
If count >= 10 Then Exit For
Next cell
' Create Pivot Cache from Source Data
Set PTCache = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
' Überprüfen ob PTCache erfolgreich erstellt wurde
If Not PTCache Is Nothing Then
Debug.Print "PivotCache wurde erfolgreich erstellt für: Jahr " & YearVal
Else
Debug.Print "Fehler bei der Erstellung von PivotCache für: Jahr " & YearVal
End If
' Die Datenquelle des PTCache anzeigen
Debug.Print "SourceType: " & PTCache.SourceType
Debug.Print "SourceData: " & PTCache.SourceData
' Set range for pivot table
' Set PRange = ThisWorkbook.Sheets.Add().Range("A1")
' Namen für das neue Arbeitsblatt vergeben
Dim newSheet As Worksheet
Set newSheet = ThisWorkbook.Sheets.Add()
newSheet.Name = YearVal
Set PRange = newSheet.Range("A1")
' Create Pivot table
Set PT = PTCache.CreatePivotTable( _
TableDestination:=PRange, _
TableName:="PivotTable" & YearVal)
' PivotTabellenName und Ziel anzeigen
Debug.Print "Pivot Table Name: " & PT.Name
Debug.Print "Table Destination: " & PT.TableRange2.Address
' Set up the row & value fields
With PT
.PivotFields("Gruppe").Orientation = xlRowField
.PivotFields("Gruppe").Orientation = xlDataField
'.PivotFields("Gruppe").Function = xlCount
End With
' Clear the AutoFilter
SrcSheet.AutoFilterMode = False
Next YearVal
End Sub
The Macro stops at this position:
' Create Pivot table
Set PT = PTCache.CreatePivotTable( _
TableDestination:=PRange, _
TableName:="PivotTable" & YearVal)
These are the values of my variables:
Year: 2018; SrcData.Address: $A$1:$B$269
Cell Address: $A$1; Value: JAHR
Cell Address: $B$1; Value: GRUPPE
Cell Address: $A$2; Value: 2018
Cell Address: $B$2; Value: ***
Cell Address: $A$3; Value: 2018
Cell Address: $B$3; Value: ***
Cell Address: $A$4; Value: 2018
Cell Address: $B$4; Value: ***
Cell Address: $A$5; Value: 2018
Cell Address: $B$5; Value: ***
PivotCache wurde erfolgreich erstellt für: Jahr 2018
SourceType: 1
SourceData: Daten!Z1S1:Z269S2
Pivot Table Name: PivotTable2018
Table Destination: $A$1:$C$18
Year: 2019; SrcData.Address: $A$1:$B$1,$A$270:$B$511
Cell Address: $A$1; Value: JAHR
Cell Address: $B$1; Value: GRUPPE
Cell Address: $A$270; Value: 2019
Cell Address: $B$270; Value: ***
Cell Address: $A$271; Value: 2019
Cell Address: $B$271; Value: ***
Cell Address: $A$272; Value: 2019
Cell Address: $B$272; Value: ***
Cell Address: $A$273; Value: 2019
Cell Address: $B$273; Value: ***
PivotCache wurde erfolgreich erstellt für: Jahr 2019
SourceType: 1
SourceData: $A$1:$B$1,[Test.xlsm]Daten!$A$270:$B$511
The data is correct, the only difference i see is the filename in "SrcData" for the year 2019
I hope you can understand my explanations :-)
Thank you
TheLiQuid
Sub CreatePivotTables()
Dim SrcSheet As Worksheet, TempSheet As Worksheet
Dim PTCache As PivotCache, PT As PivotTable
Dim FinalRow As Long, YearVal As Variant
Dim YearList As Collection
Dim wb As Workbook
Set wb = ThisWorkbook
Set SrcSheet = wb.Sheets("Daten")
Set YearList = New Collection
On Error Resume Next
FinalRow = SrcSheet.Cells(SrcSheet.Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 2 To FinalRow
YearList.Add SrcSheet.Cells(i, 1).Value, CStr(SrcSheet.Cells(i, 1).Value)
Next i
On Error GoTo 0
For Each YearVal In YearList
Dim newSheet As Worksheet
Set newSheet = wb.Sheets.Add()
newSheet.Name = YearVal
On Error Resume Next
Application.DisplayAlerts = False
wb.Sheets("Temp").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set TempSheet = wb.Sheets.Add()
TempSheet.Name = "Temp"
SrcSheet.Rows(1).Copy TempSheet.Rows(1)
SrcSheet.Range("A1:B" & FinalRow).AutoFilter Field:=1, Criteria1:=YearVal
SrcSheet.Range("A2:B" & FinalRow).SpecialCells(xlCellTypeVisible).Copy TempSheet.Range("A2")
SrcSheet.AutoFilterMode = False
Dim SrcData As Range
Set SrcData = TempSheet.UsedRange
Set PTCache = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
Set PT = PTCache.CreatePivotTable(TableDestination:=newSheet.Range("A1"), TableName:="PivotTable" & YearVal)
With PT
.PivotFields("Gruppe").Orientation = xlRowField
.PivotFields("Gruppe").Orientation = xlDataField
.PivotFields("Gruppe").Function = xlCount
End With
Application.DisplayAlerts = False
TempSheet.Delete
Application.DisplayAlerts = True
Next YearVal
MsgBox "error, bla bla", vbInformation
End Sub