VBA to create pivot tables

[Steve Saunders]

Hi all,

I'm trying to create over 200 simple pivot tables using VBA. I'm pretty new to programming, but have found lots of good tutorials so have cobbled some code together.

The code asks for a range (I use the first row of column headers), creates a new worksheet based on the value in the cell in the range, and then inserts a pivot table on the sheet that has been created. Well that is how it is supposed to work.

The code stops after it creates the first sheet and doesn't give me any error. I'm guessing that my structure/flow isn't correct. The code to create the worksheets is OK, so the problem is either in the for loop and/or the code to create the pivot table. Can anyone see where it is breaking or are there commands to debug that I can use?

Sub InsertPivotTables()
 
'Dimension variables and declare data types for new worksheets
Dim rng As Range
Dim cell As Range

'Dimension variables and declare data types for pivot tables
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

 
'Enable error handling
On Error GoTo Errorhandling
 
'Prompt for a cell range
Set rng = Application.InputBox(Prompt:="Select cell range:", _
Title:="Create worksheets", _
Default:=Selection.Address, Type:=8)
 
'Iterate through cells in selected cell range
For Each cell In rng
 
    'Check if cell is not empty
    If cell <> "" Then
 
        'Insert worksheet and name the worksheet based on cell value
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = cell

        'Pivot table code
        'Set worksheet to active sheet
        Set PSheet = Worksheets(cell)
        'Set data range - this is an existing sheet in the workbook
        Set DSheet = Worksheets("Data")

        'Define data range
        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)

        'Define pivot cache
        Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
        CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:=cell)

        'Insert blank pivot table
        Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:=cell)

        'Insert row fields
        With ActiveSheet.PivotTables(cell).PivotFields(cell)
            .Orientation = xlRowField
            .Position = 1
        End With
        
        'Insert data field
        With ActiveSheet.PivotTables(cell).PivotFields(cell)
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0"
            .Name = "YOLO "
        End With

    End If
 
'Continue with next cell in cell range
Next cell
 
'Go here if an error occurs
Errorhandling:

End Sub

Regards,
Steve

 

[Domenic]

First, temporarily comment out or remove this line...

On Error GoTo Errorhandling

Then run your code again. Which line causes the error, and what type of error is it?

 

[Steve Saunders]

First, temporarily comment out or remove this line...

On Error GoTo Errorhandling

Then run your code again. Which line causes the error, and what type of error is it?

Thanks Domenic!

Run-time error '1004'
Application-defined or object-defined error.

From a quick search it looks like the problem may be in the naming of the sheets, and that I may be trying to name two sheets the same. Would you agree?

If so, then I know the problem isn't with the code to create the sheets as I've tested that, so it must be within the pivot table code that I've introduced. I wonder if the variable cell is causing a problem as I reuse it so often or if it isn't looping properly?

Regards,
Steve

 

[Domenic]

I see one error. You'll need to replace...

Set PSheet = Worksheets(cell)

with

Set PSheet = Worksheets(cell.Value)

 

[Domenic]

If you're still having problems, temporarily comment out that line, and then try running your code again, and see where the error occurs, etc.

 

[Steve Saunders]

If you're still having problems, temporarily comment out that line, and then try running your code again, and see where the error occurs, etc.

Thank you – it's getting there. I now have one worksheet with the beginnings of a pivot table, but then I get a:

Run-time error '13':
Type mismatch

Just checked my types and they look OK to me:

'Dimension variables and declare data types for new worksheets
Dim rng As Range
Dim cell As Range

'Dimension variables and declare data types for pivot tables
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

 

[Steve Saunders]

Looks like it is breaking at this:

'Insert row fields
        With ActiveSheet.PivotTables(cell).PivotFields(cell)
            .Orientation = xlRowField
            .Position = 1
        End With

 

[Domenic]

Try specifying the Value property for each instance of cell...

        'Define pivot cache
        Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
        CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:=cell.value)

        'Insert blank pivot table
        Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:=cell.value)

        'Insert row fields
        With ActiveSheet.PivotTables(cell.value).PivotFields(cell.value)
            .Orientation = xlRowField
            .Position = 1
        End With
      
        'Insert data field
        With ActiveSheet.PivotTables(cell.value).PivotFields(cell.value)
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0"
            .Name = "YOLO "
        End With

 

[Steve Saunders]

Try specifying the Value property for each instance of cell...

        'Define pivot cache
        Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
        CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:=cell.value)

        'Insert blank pivot table
        Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:=cell.value)

        'Insert row fields
        With ActiveSheet.PivotTables(cell.value).PivotFields(cell.value)
            .Orientation = xlRowField
            .Position = 1
        End With
     
        'Insert data field
        With ActiveSheet.PivotTables(cell.value).PivotFields(cell.value)
            .Orientation = xlDataField
            .Function = xlSum
            .NumberFormat = "#,##0"
            .Name = "YOLO "
        End With

I gave that a try Domenic as soon as you gave me that tip before, but no luck - same result:

Run-time error '13':
Type mismatch

It creates the pivot table with the correct name - . The cell variable is "cdm_a1". I thought that may be the problem but changed it to "Test" and it worked fine. I also hard coded the values for the pivot table and pivot fields and got the same run-time error.

 

[Steve Saunders]

I am slowly narrowing the problem down. I discovered that message boxes can help debug.

'Define data range
        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)

        MsgBox "1"
        
        'Define pivot cache
        Set PCache = ActiveWorkbook.PivotCaches.Create _
        (SourceType:=xlDatabase, SourceData:=PRange). _
        CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
        TableName:=cell)

        MsgBox "2"

        'Insert blank pivot table
        Set PTable = PCache.CreatePivotTable _
        (TableDestination:=PSheet.Cells(1, 1), TableName:=cell)

MsgBox 1 appears, but MsgBox 2 does not.