Insert Pivot Table With Dynamic Lenghtq

[TkdKidSnake]

Hi all,

I am trying to insert a pivot table into my worksheet however the data can vary in length and I am not sure how to this using the pivot table function, the code I have currently is below.

Sub InsertPivotTable()'
' InsertPivotTable Macro
'


'
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "RawData!R1C1:R617C15", Version:=6).CreatePivotTable TableDestination:= _
        "Sheet1!R3C1", TableName:="PivotTable5", DefaultVersion:=6
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable5")
        .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("PivotTable5").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable5").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Area")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Days Past" & Chr(10) & "Due"), "Sum of Days Past" & Chr(10) & "Due", xlSum
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Days Past" & Chr(10) & "Due")
        .Caption = "Average of Days Past"
        .Function = xlAverage
        .NumberFormat = "0.0"
    End With
    Range("A1").Select
End Sub

If anyone can help me with this it would be greatly appreciated.

Thanks in advance

 

[TkdKidSnake]

I have also got the following code if it helps with setting the dynamic code - this is used higher up in the code:

    Dim sht As Worksheet    Dim LastRow As Long


    Set sht = ActiveSheet


    LastRow = sht.Range("A1").CurrentRegion.Rows.Count  
    sht.Range("A1", sht.Range("O" & LastRow)).Select

This selects all the data so I am assuming that this could be utilized in some way.

Hi all,

I am trying to insert a pivot table into my worksheet however the data can vary in length and I am not sure how to this using the pivot table function, the code I have currently is below.

Sub InsertPivotTable()'
' InsertPivotTable Macro
'


'
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "RawData!R1C1:R617C15", Version:=6).CreatePivotTable TableDestination:= _
        "Sheet1!R3C1", TableName:="PivotTable5", DefaultVersion:=6
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable5")
        .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("PivotTable5").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable5").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Area")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
        "PivotTable5").PivotFields("Days Past" & Chr(10) & "Due"), "Sum of Days Past" & Chr(10) & "Due", xlSum
    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Sum of Days Past" & Chr(10) & "Due")
        .Caption = "Average of Days Past"
        .Function = xlAverage
        .NumberFormat = "0.0"
    End With
    Range("A1").Select
End Sub

If anyone can help me with this it would be greatly appreciated.

Thanks in advance

 

[TkdKidSnake]

I have solved it for myself, this worked for me and is giving me what I need

    sht.Range("A1", sht.Range("O" & lastRow)).Select
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=1, SourceData:=Range("A1").CurrentRegion.Address)
Worksheets.Add
ActiveSheet.Name = "AverageDays"
ActiveWindow.DisplayGridlines = False
Set pt = ActiveSheet.PivotTables.Add(PivotCache:=PCache, TableDestination:=Range("A1"), TableName:="PivotTable1")


Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
        .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("PivotTable1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
End With
ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Area")
        .Orientation = xlRowField
        .Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Days Past" & Chr(10) & "Due"), "Sum of Days Past" & Chr(10) & "Due", xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Days Past" & Chr(10) & "Due")
        .Caption = "Average of Days Past"
        .Function = xlAverage
        .NumberFormat = "0.0"
End With
    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Cells.Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Size = 12
    Cells.EntireColumn.AutoFit
    '
    Range("A1:B6").Select
    Range("B6").Activate
    ActiveSheet.PageSetup.PrintArea = "$A$1:$B$6"
        ActiveSheet.Unprotect
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("C1").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
    '
    Range("A1").Select