Pivot Table for Dynamic Cell Ranges

[sahaider]

Hi,
I have created a pivot table for fixed cell range which has the code below in the starting:

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Test!R1C1:R320C4", Version:=6).CreatePivotTable _
        TableDestination:="Sheet1!R3C1", TableName:="PivotTable2", DefaultVersion _
        :=6

As can be seen Pivot table is being created in Sheet1 for cell ranges R1C1 upto R320C4 included in Test sheet

What I would like is to convert the above code so cell ranges is always Dynamic and Pivot will be always created for that Dynamic cell ranges. The column count of the source cell range will remain fixed as 5 but row count will be dynamic.

Any advice would be nice.

 

[Alex Blakenburg]

See if this works for you.

Sub PivotDynamicRows()

    Dim rngData As Range
    Dim shtData As Worksheet
    
    Set shtData = Worksheets("Test")
    Set rngData = shtData.Range("A1:D" & shtData.Range("A" & shtData.Rows.Count).End(xlUp).Row)

    ' replaced SourceData with rngData
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            rngData, Version:=6).CreatePivotTable _
            TableDestination:="Sheet1!R3C1", TableName:="PivotTable2", DefaultVersion _
            :=6

End Sub

 

[sahaider]

Hi ,

I am getting runtime error 5 for the Bold part in the code.


Please see the full code below:

Sub Calculate_Route_Length()
'        
    Sheets.Add(After:=Sheets("Drive Route Length Clutter")).Name = "Pivot & Reporting"
       
    Dim rngData As Range
    Dim shtData As Worksheet
    
    Set shtData = Worksheets("Drive Route Length Clutter")
    Set rngData = shtData.Range("A1:D" & shtData.Range("A" & shtData.Rows.Count).End(xlUp).Row)

    ' replaced SourceData with rngData
    
        [B]ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            rngData, Version:=6).CreatePivotTable _
            TableDestination:="Pivot & Reporting!R3C1", TableName:="PivotTable2", DefaultVersion _
            :=6[/B]
    
    Sheets("Pivot & Reporting").Select
    Cells(3, 1).Select
    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
    
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Wider Clas")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Length"), "Sum of Length", xlSum
End Sub

 

[Alex Blakenburg]

Can I get you to replace all the code from
Sheets.Add up to and including the line its erroring out on with this:-

    Dim rngData As Range
    Dim shtData As Worksheet
    Dim shtOutput As Worksheet
    
    Sheets.Add(After:=Sheets("Drive Route Length Clutter")).Name = "Pivot & Reporting"
    Set shtOutput = ActiveSheet
    
    Set shtData = Worksheets("Drive Route Length Clutter")
    Set rngData = shtData.Range("A1:D" & shtData.Range("A" & shtData.Rows.Count).End(xlUp).Row)

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        rngData, Version:=6).CreatePivotTable _
        TableDestination:=shtOutput.Range("A3"), TableName:="PivotTable1", DefaultVersion:=6