locked
PivotTable not showing correct data from Macro RRS feed

  • Question

  • Hi,

    I record my macro to get the Pivot table in green.

    When I re-run, I get the pivot table in red not matching like green.

    What should I fix in the macro code to get the pivot table in green?

    Thanks.

    Sub Macro3()
    '
    ' Macro3 Macro
    '
    
    '
        Cells.Select
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "Data!R1C1:R1048576C4", Version:=6).CreatePivotTable TableDestination:= _
            "Summary!R2C2", TableName:="PivotTable1", DefaultVersion:=6
        Sheets("Summary").Select
        Cells(2, 2).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("TYPE")
            .Orientation = xlRowField
            .Position = 1
        End With
        ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
            "PivotTable1").PivotFields("TYPE"), "Count of TYPE", xlCount
        With ActiveSheet.PivotTables("PivotTable1").PivotFields("TYPE")
            .PivotItems("(blank)").Visible = False
        End With
    End Sub
    

    Date	LBs	Purchase	TYPE
    10-Feb	20	gala apple	FRUIT
    10-Feb	10	navel orange	FRUIT
    10-Feb	20	apple	FRUIT
    10-Feb	12	carrot	VEGETABLE
    10-Feb	4	sweet potato	VEGETABLE
    10-Feb	656	lettuce	N/A
    10-Feb	56	onions	N/A
    10-Feb	5	red apple	FRUIT
    10-Feb	6	green apple	FRUIT
    10-Feb	6	navel orange	FRUIT
    10-Feb	6	apple	FRUIT
    10-Feb	6	carrot	VEGETABLE
    10-Feb	6	sweet potato	VEGETABLE
    10-Feb	6	lettuce	N/A
    10-Feb	6	onions	N/A
    10-Feb	6	red apple	FRUIT
    10-Feb	6	green-apple	FRUIT
    10-Feb	6	banana	N/A
    10-Feb	6		N/A
    10-Feb	6		N/A
    10-Feb	6	apple-1-XX-9840-X8	FRUIT
    10-Feb	6	45	N/A
    10-Feb	6	27 cherry	FRUIT
    


    Sunday, February 16, 2020 4:17 AM

Answers

  • Like this:

    Sub Macro3()
        Dim pvc As PivotCache
        Dim pvt As PivotTable
        ' Create the pivot cache
        Set pvc = ActiveWorkbook.PivotCaches.Create( _
            SourceType:=xlDatabase, _
            SourceData:="Data!" & Worksheets("Data").Range("A1").CurrentRegion.Address)
        ' Create the pivot table
        Set pvt = pvc.CreatePivotTable( _
            TableDestination:="Summary!R2C2", _
            TableName:="PivotTable1")
        With pvt
            ' Add the Type field
            .AddFields RowFields:="Type"
            ' Move it to the Values area
            .AddDataField .PivotFields("Type"), "Count of Type", xlCount
            ' Add the Type field again
            .AddFields RowFields:="Type"
        End With
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    • Marked as answer by slick.user Monday, February 17, 2020 4:23 AM
    Sunday, February 16, 2020 11:00 AM