Pivot table not created due to sheet reference

Hello,

I have the below code to create a pivot table based off of a data set. It is a template that will be used going forward however the code references Sheets("Sheet33").Select in it. The problem with this is when I test and delete tabs and rerun the code the sheet is not Sheet 33 any longer. What can I put to make it dynamic? I have code that creates two pivot tables and they both have this problem.

Sub Dept76000Pivot()
'
' Dept76000Pivot Macro
'

'
    Dim LastRow6 As Long
    With Worksheets("76000 Original")
    Sheets("76000 Original").Select
    Sheets.Add
    LastRow6 = .Range("C" & Rows.Count).End(xlUp).Row
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "76000 Original!R4C1:R" & LastRow6 & "C21", Version:=6).CreatePivotTable _
        TableDestination:="Sheet32!R3C1", TableName:="PivotTable2", DefaultVersion _
        :=6
    Sheets("Sheet32").Select
    Cells(3, 1).Select
    End With
    With ActiveSheet.PivotTables("PivotTable2")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
    Sheets("Sheet32").Select
    Sheets("Sheet32").Name = "76000"
    Sheets("76000").Select
    With ActiveWorkbook.Sheets("76000").Tab
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("GL String")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Debit"), "Sum of Debit", xlSum
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Credit"), "Sum of Credit", xlSum
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Company CO")
        .Orientation = xlColumnField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Cost Center")
        .Orientation = xlColumnField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Region")
        .Orientation = xlColumnField
        .Position = 4
    End With
    Sheets("76000").Select
    Sheets("76000").Move After:=Sheets(13)
End Sub

Hi there,

This proposed solution is untested as I don't have access to your workbook.

I'm assuming (maybe a BIG assumption!) that the "Sheet32" you're referring to is the name which Excel assigned to the new worksheet when you created your code using the macro recorder.

See if the following code does what you need - I've tried to tidy up the code generated by the macro recorder:

Option Explicit


Sub Dept76000Pivot()

    Const sORIGINAL_SHEET   As String = "76000 Original"
    Const sPIVOT_TABLE      As String = "PivotTable1"
    Const sNEW_SHEET        As String = "76000"

    Dim sSourceData         As String
    Dim sTargetData         As String
    Dim lLastRow6           As Long
    Dim wksNew              As Worksheet

    With Worksheets(sORIGINAL_SHEET)
        lLastRow6 = .Range("C" & Rows.Count).End(xlUp).Row
    End With

    Sheets.Add
    Set wksNew = ActiveSheet

    With wksNew

        .Name = sNEW_SHEET
        .Cells(3, 1).Select

        .Tab.ThemeColor = xlThemeColorLight1
        .Tab.TintAndShade = 0

    End With


    sSourceData = sORIGINAL_SHEET & "!R4C1:R" & lLastRow6 & "C21"
    sTargetData = wksNew.Name & "!R3C1"

    ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                    SourceData:=sSourceData, _
                                    Version:=6).CreatePivotTable _
                                    TableDestination:=sTargetData, _
                                    TableName:=sPIVOT_TABLE, _
                                    DefaultVersion:=6

    With wksNew.PivotTables(sPIVOT_TABLE)

        .DisplayMemberPropertyTooltips = False
        .RepeatItemsOnEachPrintedPage = True
        .CalculatedMembersInFilters = False
        .FieldListSortAscending = False
        .DisplayContextTooltips = True
        .DisplayFieldCaptions = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .ShowDrillIndicators = True
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .EnableDrilldown = True
        .InGridDropZones = False
        .PageFieldOrder = 2
        .HasAutoFormat = True
        .ShowValuesRow = False
        .ColumnGrand = True
        .MergeLabels = False
        .PrintTitles = False
        .ErrorString = ""
        .NullString = ""
        .RowGrand = True
        .SaveData = True

'~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

        .RepeatAllLabels xlRepeatLabels
        .RowAxisLayout xlCompactRow

'~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

        .AddDataField .PivotTables(sPIVOT_TABLE).PivotFields("Debit"), _
                      "Sum of Debit", xlSum

        .AddDataField .PivotTables(sPIVOT_TABLE).PivotFields("Credit"), _
                      "Sum of Credit", xlSum

'~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

        With .PivotFields("GL String")
            .Orientation = xlRowField
            .Position = 1
        End With

        With .PivotFields("Company CO")
            .Orientation = xlColumnField
            .Position = 2
        End With

        With .PivotFields("Cost Center")
            .Orientation = xlColumnField
            .Position = 3
        End With

        With .PivotFields("Region")
            .Orientation = xlColumnField
            .Position = 4
        End With

'~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

        With .PivotCache
            .RefreshOnFileOpen = False
            .MissingItemsLimit = xlMissingItemsDefault
        End With

    End With

    With ThisWorkbook
        wksNew.Move After:=.Worksheets(.Worksheets.Count)
    End With

    wksNew.Select

End Sub

The newly-created worksheet will appear as the last worksheet of the workbook.

You can change the highlighted values to suit your own requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M

Thanks Greg!

I ended up rebuilding the code with some google research and was able to get it to work. The code is below. I appreciate your help.

Sub InsertPivotTable71500()

'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow8 As Long
Dim LastCol As Long

'Insert a New Blank Worksheet
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("71500").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "71500"
Application.DisplayAlerts = True
Set PSheet = Worksheets("71500")
Set DSheet = Worksheets("71500 Original")

'Define Data Range
LastRow8 = 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)
Set PRange = DSheet.Range("A4:U" & LastRow8)

'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(1, 1), _
TableName:="71500PivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="71500PivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("71500PivotTable").PivotFields("GL String")
.Orientation = xlRowField
.Position = 1
End With

 ActiveSheet.PivotTables("71500PivotTable").AddDataField ActiveSheet.PivotTables( _
        "71500PivotTable").PivotFields("Debit"), "Sum of Debit", xlSum
    ActiveSheet.PivotTables("71500PivotTable").AddDataField ActiveSheet.PivotTables( _
        "71500PivotTable").PivotFields("Credit"), "Sum of Credit", xlSum
        
'Insert Column Fields
With ActiveSheet.PivotTables("71500PivotTable").PivotFields("Company CO")
.Orientation = xlColumnField
.Position = 2
End With

'Insert Column Fields
With ActiveSheet.PivotTables("71500PivotTable").PivotFields("Cost Center")
.Orientation = xlColumnField
.Position = 3
End With

'Insert Column Fields
With ActiveSheet.PivotTables("71500PivotTable").PivotFields("Region")
.Orientation = xlColumnField
.Position = 4
End With

End Sub

Hi again,

Many thanks for your very prompt feedback and also for the Reputation increase - much appreciated!

You're welcome - glad I was able to help.

Best regards,

Greg M