VBA - Pivot table - Macro tweak

D

dstepan

Board Regular
Joined
Apr 16, 2009
Messages
160
[TABLE="width: 448"]
<colgroup><col span="7"></colgroup><tbody>[TR]
[TD="colspan: 2"]Hi Everyone[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]I am trying to make this workbook fully automated as the user is not Excel savvy.[/TD]
[/TR]
[TR]
[TD="colspan: 7"]Also, I am still learning to code so much of what I have here is by "Record macro"[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 5"]I have two problems I was hoping to get help on.[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]Problem 1: [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]I have a new workbook with Sheet1 which is copied from another workbook.[/TD]
[/TR]
[TR]
[TD="colspan: 5"]Sheet1 is my data for creating 4 pivot tables.[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 4"]My data range can change monthly.[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]Last month I had 170 lines of data (a1:k170). Not including the tiltles and totals.[/TD]
[/TR]
[TR]
[TD="colspan: 7"]This month I have 173 lines of data (a1:k173). Not including the titles and totals.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]Currently, I am only trying to work with the first pivot to try to get it adjust the data source.[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]However, the pivot data range is not refreshing when I recreate the pivot table sheets.[/TD]
[/TR]
[TR]
[TD="colspan: 6"]I searched everywhere for something that I could replicate.[/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]Of which I did find and tweaked and saved as a Macro "AdjustDataSource[/TD]
[/TR]
[TR]
[TD="colspan: 7"]**I called the "AdjustDataSource" macro on line 20 of my "OrderBacklog3FinalwPivots" macro[/TD]
[/TR]
[TR]
[TD="colspan: 7"]This does not work. It is failing to pick up the extra 3 lines of data.[/TD]
[/TR]
[TR]
[TD="colspan: 5"]Any ideas on how to get the data source to update.[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]Problem 2:[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]My Sheet3 pivot table is to filter the customer list consisting of the same 4 customers each month.[/TD]
[/TR]
[TR]
[TD="colspan: 7"]It is about 2/3 the way down in the code. I put some asterisks at the end of the lines only to point them out. They are not in the actual code.[/TD]
[/TR]
[TR]
[TD="colspan: 7"]Originally, when using the Macro Recorder, all the customers not selected where listed with a "FALSE" notation.[/TD]
[/TR]
[TR]
[TD="colspan: 5"] IE: .PivotItems("XYZ").Visible = False *****[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]This also was not updating, so I thought I could write the reverse and list the customers I needed and notate them as "TRUE"[/TD]
[/TR]
[TR]
[TD]Below you will find the code[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 7"]Any suggestions on either of these issue will help immensely.[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 1051"]
<colgroup><col></colgroup><tbody>[TR]
[TD]
Rich (BB code): 
[/TD]
[/TR]
[TR]
[TD]Sub OrderBacklog3FinalwPivots()[/TD]
[/TR]
[TR]
[TD]'[/TD]
[/TR]
[TR]
[TD]' OrderBacklog3FinalwPivots Macro[/TD]
[/TR]
[TR]
[TD]   [/TD]
[/TR]
[TR]
[TD]Sheets("Sheet1").Columns("G:K").Copy[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Columns("G:K").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _[/TD]
[/TR]
[TR]
[TD]        xlNone, SkipBlanks:=False, Transpose:=False[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.SaveAs Filename:="H:\Accounting\ABC Services Inc\Accounting\Month End Financial Close\2019 Month End Close\ORDER BACKLOG PREP.xlsx", _[/TD]
[/TR]
[TR]
[TD]        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Select[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Copy[/TD]
[/TR]
[TR]
[TD]    ChDir _[/TD]
[/TR]
[TR]
[TD]        "H:\Accounting\ABC Services Inc\Accounting\Month End Financial Close\2019 Month End Close"[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.SaveAs Filename:= _[/TD]
[/TR]
[TR]
[TD]        "H:\Accounting\ABC Services Inc\Accounting\Month End Financial Close\2019 Month End Close\Order Backlog.xlsm" _[/TD]
[/TR]
[TR]
[TD]        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False[/TD]
[/TR]
[TR]
[TD]    Range("B12").Select[/TD]
[/TR]
[TR]
[TD]    Sheets.Add[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _[/TD]
[/TR]
[TR]
[TD]        "Sheet1!R1C1:R170C11", Version:=6).CreatePivotTable TableDestination:= _[/TD]
[/TR]
[TR]
[TD]        "Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion:=6[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet2").Select[/TD]
[/TR]
[TR]
[TD]    Cells(3, 1).Select[/TD]
[/TR]
[TR]
[TD]    Call AdjustDataSource[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable1")[/TD]
[/TR]
[TR]
[TD]        .ColumnGrand = True[/TD]
[/TR]
[TR]
[TD]        .HasAutoFormat = True[/TD]
[/TR]
[TR]
[TD]        .DisplayErrorString = False[/TD]
[/TR]
[TR]
[TD]        .DisplayNullString = True[/TD]
[/TR]
[TR]
[TD]        .EnableDrilldown = True[/TD]
[/TR]
[TR]
[TD]        .ErrorString = ""[/TD]
[/TR]
[TR]
[TD]        .MergeLabels = False[/TD]
[/TR]
[TR]
[TD]        .NullString = ""[/TD]
[/TR]
[TR]
[TD]        .PageFieldOrder = 2[/TD]
[/TR]
[TR]
[TD]        .PageFieldWrapCount = 0[/TD]
[/TR]
[TR]
[TD]        .PreserveFormatting = True[/TD]
[/TR]
[TR]
[TD]        .RowGrand = True[/TD]
[/TR]
[TR]
[TD]        .SaveData = True[/TD]
[/TR]
[TR]
[TD]        .PrintTitles = False[/TD]
[/TR]
[TR]
[TD]        .RepeatItemsOnEachPrintedPage = True[/TD]
[/TR]
[TR]
[TD]        .TotalsAnnotation = False[/TD]
[/TR]
[TR]
[TD]        .CompactRowIndent = 1[/TD]
[/TR]
[TR]
[TD]        .InGridDropZones = False[/TD]
[/TR]
[TR]
[TD]        .DisplayFieldCaptions = True[/TD]
[/TR]
[TR]
[TD]        .DisplayMemberPropertyTooltips = False[/TD]
[/TR]
[TR]
[TD]        .DisplayContextTooltips = True[/TD]
[/TR]
[TR]
[TD]        .ShowDrillIndicators = True[/TD]
[/TR]
[TR]
[TD]        .PrintDrillIndicators = False[/TD]
[/TR]
[TR]
[TD]        .AllowMultipleFilters = False[/TD]
[/TR]
[TR]
[TD]        .SortUsingCustomLists = True[/TD]
[/TR]
[TR]
[TD]        .FieldListSortAscending = False[/TD]
[/TR]
[TR]
[TD]        .ShowValuesRow = False[/TD]
[/TR]
[TR]
[TD]        .CalculatedMembersInFilters = False[/TD]
[/TR]
[TR]
[TD]        .RowAxisLayout xlCompactRow[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable1").PivotCache[/TD]
[/TR]
[TR]
[TD]        .RefreshOnFileOpen = False[/TD]
[/TR]
[TR]
[TD]        .MissingItemsLimit = xlMissingItemsDefault[/TD]
[/TR]
[TR]
[TD]    Call AdjustDataSource[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable1").RepeatAllLabels xlRepeatLabels[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Type")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlRowField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _[/TD]
[/TR]
[TR]
[TD]        "PivotTable1").PivotFields("Ext Price"), "Sum of Ext Price", xlSum[/TD]
[/TR]
[TR]
[TD]    Columns("B:B").Select[/TD]
[/TR]
[TR]
[TD]    Selection.Style = "Comma"[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Select[/TD]
[/TR]
[TR]
[TD]    Sheets.Add[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").PivotCache. _[/TD]
[/TR]
[TR]
[TD]        CreatePivotTable TableDestination:="Sheet3!R3C1", TableName:="PivotTable2" _[/TD]
[/TR]
[TR]
[TD]        , DefaultVersion:=6[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet3").Select[/TD]
[/TR]
[TR]
[TD]    Cells(3, 1).Select[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable2")[/TD]
[/TR]
[TR]
[TD]        .ColumnGrand = True[/TD]
[/TR]
[TR]
[TD]        .HasAutoFormat = True[/TD]
[/TR]
[TR]
[TD]        .DisplayErrorString = False[/TD]
[/TR]
[TR]
[TD]        .DisplayNullString = True[/TD]
[/TR]
[TR]
[TD]        .EnableDrilldown = True[/TD]
[/TR]
[TR]
[TD]        .ErrorString = ""[/TD]
[/TR]
[TR]
[TD]        .MergeLabels = False[/TD]
[/TR]
[TR]
[TD]        .NullString = ""[/TD]
[/TR]
[TR]
[TD]        .PageFieldOrder = 2[/TD]
[/TR]
[TR]
[TD]        .PageFieldWrapCount = 0[/TD]
[/TR]
[TR]
[TD]        .PreserveFormatting = True[/TD]
[/TR]
[TR]
[TD]        .RowGrand = True[/TD]
[/TR]
[TR]
[TD]        .SaveData = True[/TD]
[/TR]
[TR]
[TD]        .PrintTitles = False[/TD]
[/TR]
[TR]
[TD]        .RepeatItemsOnEachPrintedPage = True[/TD]
[/TR]
[TR]
[TD]        .TotalsAnnotation = False[/TD]
[/TR]
[TR]
[TD]        .CompactRowIndent = 1[/TD]
[/TR]
[TR]
[TD]        .InGridDropZones = False[/TD]
[/TR]
[TR]
[TD]        .DisplayFieldCaptions = True[/TD]
[/TR]
[TR]
[TD]        .DisplayMemberPropertyTooltips = False[/TD]
[/TR]
[TR]
[TD]        .DisplayContextTooltips = True[/TD]
[/TR]
[TR]
[TD]        .ShowDrillIndicators = True[/TD]
[/TR]
[TR]
[TD]        .PrintDrillIndicators = False[/TD]
[/TR]
[TR]
[TD]        .AllowMultipleFilters = False[/TD]
[/TR]
[TR]
[TD]        .SortUsingCustomLists = True[/TD]
[/TR]
[TR]
[TD]        .FieldListSortAscending = False[/TD]
[/TR]
[TR]
[TD]        .ShowValuesRow = False[/TD]
[/TR]
[TR]
[TD]        .CalculatedMembersInFilters = False[/TD]
[/TR]
[TR]
[TD]        .RowAxisLayout xlCompactRow[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable2").PivotCache[/TD]
[/TR]
[TR]
[TD]        .RefreshOnFileOpen = False[/TD]
[/TR]
[TR]
[TD]        .MissingItemsLimit = xlMissingItemsDefault[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels[/TD]
[/TR]
[TR]
[TD]    Range("B10").Select[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Quarter")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlRowField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _[/TD]
[/TR]
[TR]
[TD]        "PivotTable2").PivotFields("Ext Price"), "Sum of Ext Price", xlSum[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _[/TD]
[/TR]
[TR]
[TD]        "PivotTable2").PivotFields("Profit"), "Sum of Profit", xlSum[/TD]
[/TR]
[TR]
[TD]    Columns("B:C").Select[/TD]
[/TR]
[TR]
[TD]    Selection.Style = "Comma"[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Select[/TD]
[/TR]
[TR]
[TD]    Sheets.Add[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").PivotCache. _[/TD]
[/TR]
[TR]
[TD]        CreatePivotTable TableDestination:="Sheet4!R3C1", TableName:="PivotTable3" _[/TD]
[/TR]
[TR]
[TD]        , DefaultVersion:=6[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet4").Select[/TD]
[/TR]
[TR]
[TD]    Cells(3, 1).Select[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable3")[/TD]
[/TR]
[TR]
[TD]        .ColumnGrand = True[/TD]
[/TR]
[TR]
[TD]        .HasAutoFormat = True[/TD]
[/TR]
[TR]
[TD]        .DisplayErrorString = False[/TD]
[/TR]
[TR]
[TD]        .DisplayNullString = True[/TD]
[/TR]
[TR]
[TD]        .EnableDrilldown = True[/TD]
[/TR]
[TR]
[TD]        .ErrorString = ""[/TD]
[/TR]
[TR]
[TD]        .MergeLabels = False[/TD]
[/TR]
[TR]
[TD]        .NullString = ""[/TD]
[/TR]
[TR]
[TD]        .PageFieldOrder = 2[/TD]
[/TR]
[TR]
[TD]        .PageFieldWrapCount = 0[/TD]
[/TR]
[TR]
[TD]        .PreserveFormatting = True[/TD]
[/TR]
[TR]
[TD]        .RowGrand = True[/TD]
[/TR]
[TR]
[TD]        .SaveData = True[/TD]
[/TR]
[TR]
[TD]        .PrintTitles = False[/TD]
[/TR]
[TR]
[TD]        .RepeatItemsOnEachPrintedPage = True[/TD]
[/TR]
[TR]
[TD]        .TotalsAnnotation = False[/TD]
[/TR]
[TR]
[TD]        .CompactRowIndent = 1[/TD]
[/TR]
[TR]
[TD]        .InGridDropZones = False[/TD]
[/TR]
[TR]
[TD]        .DisplayFieldCaptions = True[/TD]
[/TR]
[TR]
[TD]        .DisplayMemberPropertyTooltips = False[/TD]
[/TR]
[TR]
[TD]        .DisplayContextTooltips = True[/TD]
[/TR]
[TR]
[TD]        .ShowDrillIndicators = True[/TD]
[/TR]
[TR]
[TD]        .PrintDrillIndicators = False[/TD]
[/TR]
[TR]
[TD]        .AllowMultipleFilters = False[/TD]
[/TR]
[TR]
[TD]        .SortUsingCustomLists = True[/TD]
[/TR]
[TR]
[TD]        .FieldListSortAscending = False[/TD]
[/TR]
[TR]
[TD]        .ShowValuesRow = False[/TD]
[/TR]
[TR]
[TD]        .CalculatedMembersInFilters = False[/TD]
[/TR]
[TR]
[TD]        .RowAxisLayout xlCompactRow[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable3").PivotCache[/TD]
[/TR]
[TR]
[TD]        .RefreshOnFileOpen = False[/TD]
[/TR]
[TR]
[TD]        .MissingItemsLimit = xlMissingItemsDefault[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable3").RepeatAllLabels xlRepeatLabels[/TD]
[/TR]
[TR]
[TD]    Range("C11").Select[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Customer")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlRowField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Customer")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlPageField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Quarter")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlRowField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _[/TD]
[/TR]
[TR]
[TD]        "PivotTable3").PivotFields("Ext Price"), "Sum of Ext Price", xlSum[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _[/TD]
[/TR]
[TR]
[TD]        "PivotTable3").PivotFields("Profit"), "Sum of Profit", xlSum[/TD]
[/TR]
[TR]
[TD]    Columns("B:C").Select[/TD]
[/TR]
[TR]
[TD]    Selection.Style = "Comma"[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet3").Select[/TD]
[/TR]
[TR]
[TD]    Range("B5").Select[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlPageField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer").CurrentPage = _[/TD]
[/TR]
[TR]
[TD]        "(All)"[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer")[/TD]
[/TR]
[TR]
[TD]        .PivotItems("CDE").Visible = True     *****[/TD]
[/TR]
[TR]
[TD]        .PivotItems("FGH").Visible = True     *****[/TD]
[/TR]
[TR]
[TD]        .PivotItems("IJK").Visible = True        *****[/TD]
[/TR]
[TR]
[TD]        .PivotItems("LMN").Visible = True    *****[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer"). _[/TD]
[/TR]
[TR]
[TD]        EnableMultiplePageItems = True[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer").CurrentPage = _[/TD]
[/TR]
[TR]
[TD]        "(All)"[/TD]
[/TR]
[TR]
[TD]    Columns("B:C").Select[/TD]
[/TR]
[TR]
[TD]    Selection.Style = "Comma"[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Select[/TD]
[/TR]
[TR]
[TD]    Sheets.Add[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").PivotCache. _[/TD]
[/TR]
[TR]
[TD]        CreatePivotTable TableDestination:="Sheet5!R3C1", TableName:="PivotTable4" _[/TD]
[/TR]
[TR]
[TD]        , DefaultVersion:=6[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet5").Select[/TD]
[/TR]
[TR]
[TD]    Cells(3, 1).Select[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable4")[/TD]
[/TR]
[TR]
[TD]        .ColumnGrand = True[/TD]
[/TR]
[TR]
[TD]        .HasAutoFormat = True[/TD]
[/TR]
[TR]
[TD]        .DisplayErrorString = False[/TD]
[/TR]
[TR]
[TD]        .DisplayNullString = True[/TD]
[/TR]
[TR]
[TD]        .EnableDrilldown = True[/TD]
[/TR]
[TR]
[TD]        .ErrorString = ""[/TD]
[/TR]
[TR]
[TD]        .MergeLabels = False[/TD]
[/TR]
[TR]
[TD]        .NullString = ""[/TD]
[/TR]
[TR]
[TD]        .PageFieldOrder = 2[/TD]
[/TR]
[TR]
[TD]        .PageFieldWrapCount = 0[/TD]
[/TR]
[TR]
[TD]        .PreserveFormatting = True[/TD]
[/TR]
[TR]
[TD]        .RowGrand = True[/TD]
[/TR]
[TR]
[TD]        .SaveData = True[/TD]
[/TR]
[TR]
[TD]        .PrintTitles = False[/TD]
[/TR]
[TR]
[TD]        .RepeatItemsOnEachPrintedPage = True[/TD]
[/TR]
[TR]
[TD]        .TotalsAnnotation = False[/TD]
[/TR]
[TR]
[TD]        .CompactRowIndent = 1[/TD]
[/TR]
[TR]
[TD]        .InGridDropZones = False[/TD]
[/TR]
[TR]
[TD]        .DisplayFieldCaptions = True[/TD]
[/TR]
[TR]
[TD]        .DisplayMemberPropertyTooltips = False[/TD]
[/TR]
[TR]
[TD]        .DisplayContextTooltips = True[/TD]
[/TR]
[TR]
[TD]        .ShowDrillIndicators = True[/TD]
[/TR]
[TR]
[TD]        .PrintDrillIndicators = False[/TD]
[/TR]
[TR]
[TD]        .AllowMultipleFilters = False[/TD]
[/TR]
[TR]
[TD]        .SortUsingCustomLists = True[/TD]
[/TR]
[TR]
[TD]        .FieldListSortAscending = False[/TD]
[/TR]
[TR]
[TD]        .ShowValuesRow = False[/TD]
[/TR]
[TR]
[TD]        .CalculatedMembersInFilters = False[/TD]
[/TR]
[TR]
[TD]        .RowAxisLayout xlCompactRow[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable4").PivotCache[/TD]
[/TR]
[TR]
[TD]        .RefreshOnFileOpen = False[/TD]
[/TR]
[TR]
[TD]        .MissingItemsLimit = xlMissingItemsDefault[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable4").RepeatAllLabels xlRepeatLabels[/TD]
[/TR]
[TR]
[TD]    With ActiveSheet.PivotTables("PivotTable4").PivotFields("Customer")[/TD]
[/TR]
[TR]
[TD]        .Orientation = xlRowField[/TD]
[/TR]
[TR]
[TD]        .Position = 1[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _[/TD]
[/TR]
[TR]
[TD]        "PivotTable4").PivotFields("Ext Price"), "Sum of Ext Price", xlSum[/TD]
[/TR]
[TR]
[TD]    Columns("B:b").Select[/TD]
[/TR]
[TR]
[TD]    Selection.Style = "Comma"[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Select[/TD]
[/TR]
[TR]
[TD]    Sheets.Add After:=ActiveSheet[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet6").Select[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet6").Move Before:=Sheets(5)[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet1").Select[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.Range("$A$1:$K$170").AutoFilter Field:=2, Criteria1:=Array( _[/TD]
[/TR]
[TR]
[TD]        "CDE", "FGH", "IJK", "LMN"), Operator:=xlFilterValues[/TD]
[/TR]
[TR]
[TD]    Range("A1").Select[/TD]
[/TR]
[TR]
[TD]    Range(Selection, Selection.End(xlToRight)).Select[/TD]
[/TR]
[TR]
[TD]    Range(Selection, Selection.End(xlDown)).Select[/TD]
[/TR]
[TR]
[TD]    Selection.Copy[/TD]
[/TR]
[TR]
[TD]    Sheets("Sheet6").Select[/TD]
[/TR]
[TR]
[TD]    ActiveSheet.Paste[/TD]
[/TR]
[TR]
[TD]    Columns("A:A").EntireColumn.AutoFit[/TD]
[/TR]
[TR]
[TD]    Cells.Select[/TD]
[/TR]
[TR]
[TD]    Cells.EntireColumn.AutoFit[/TD]
[/TR]
[TR]
[TD]    Columns("G:K").Select[/TD]
[/TR]
[TR]
[TD]    Application.CutCopyMode = False[/TD]
[/TR]
[TR]
[TD]    With Selection[/TD]
[/TR]
[TR]
[TD]        .HorizontalAlignment = xlCenter[/TD]
[/TR]
[TR]
[TD]        .WrapText = False[/TD]
[/TR]
[TR]
[TD]        .Orientation = 0[/TD]
[/TR]
[TR]
[TD]        .AddIndent = False[/TD]
[/TR]
[TR]
[TD]        .IndentLevel = 0[/TD]
[/TR]
[TR]
[TD]        .ShrinkToFit = False[/TD]
[/TR]
[TR]
[TD]        .ReadingOrder = xlContext[/TD]
[/TR]
[TR]
[TD]        .MergeCells = False[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]    ActiveWorkbook.Save[/TD]
[/TR]
[TR]
[TD]End Sub[/TD]
[/TR]
[TR]
[TD]
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]
Rich (BB code): 
[/TD]
[/TR]
[TR]
[TD]Sub AdjustDataSource()[/TD]
[/TR]
[TR]
[TD]'PURPOSE: Automatically readjust a Pivot Table's data source range[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Dim Data_sht As Worksheet[/TD]
[/TR]
[TR]
[TD]Dim StartPoint As Range[/TD]
[/TR]
[TR]
[TD]Dim DataRange As Range[/TD]
[/TR]
[TR]
[TD]Dim NewRange As String[/TD]
[/TR]
[TR]
[TD]Set Data_sht = ThisWorkbook.Worksheets("Sheet1")[/TD]
[/TR]
[TR]
[TD]Set StartPoint = Data_sht.Range("A1")[/TD]
[/TR]
[TR]
[TD]Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))[/TD]
[/TR]
[TR]
[TD]NewRange = Data_sht.Name & "!" & _[/TD]
[/TR]
[TR]
[TD]DataRange.Address(ReferenceStyle:=xlR1C1)[/TD]
[/TR]
[TR]
[TD]End Sub[/TD]
[/TR]
[TR]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Re: VBA - Pivot table - Macro tweak - help

These subs will help with the problems you listed:

Code: 
Sub ResetPTSourceRange(sWorksheeetName As String)
    'Assumes the source data for a PT starts at Range("A1")
    'Resets the source data to occupy the current region for Range("A1") on the current source data worksheet
    'Added Replace single quotes to 3rd line 20160712
    Dim pt As PivotTable
    
    Set pt = Worksheets(sWorksheeetName).PivotTables(1)
    Debug.Print "Before PT Source: " & pt.SourceData
    pt.ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        Split(pt.SourceData, "!")(0) & "!" & _
        Worksheets(Replace(Split(pt.SourceData, "!")(0), "'", "")).Range("A1").CurrentRegion.Address(, , xlR1C1), _
        Version:=xlPivotTableVersion14)
    Debug.Print " After PT Source: " & pt.SourceData
    Set pt = Nothing

End Sub

Sub ShowDesiredPivotItems(sPivotField As String, sPivotItemList As String)
    
    'sPivotItemList is a single PivotItem ("One"), or
    '  a string of PivotItems, separated by commas ("One,Two,Three")

    Dim lPIIndex As Long
    Dim bFound As Boolean
    Dim aryPivotItemList As Variant
    Dim lPivotItemListIndex As Long
    Dim sCSVPivotItemList As String
    Dim sPI As String
    Dim bInList As Boolean
    
    sPivotField = UCase(sPivotField)
    sPivotItemList = UCase(sPivotItemList)
    
    'Handle multiple PivotItems
    aryPivotItemList = Split(sPivotItemList, ",")
    For lPivotItemListIndex = LBound(aryPivotItemList) To UBound(aryPivotItemList)
        aryPivotItemList(lPivotItemListIndex) = Trim(aryPivotItemList(lPivotItemListIndex))
        sCSVPivotItemList = sCSVPivotItemList & "," & Chr(34) & aryPivotItemList(lPivotItemListIndex) & Chr(34)
    Next
    sCSVPivotItemList = Mid(sCSVPivotItemList, 2)
    If ActiveSheet.PivotTables.Count = 0 Then
        MsgBox "No PivotTables on the active sheet"
        GoTo End_Sub
    End If
    
    With ActiveSheet.PivotTables(1)
        If .PivotFields(sPivotField).Orientation = xlHidden Then
            MsgBox "The " & sPivotField & " PivotField is hidden.  Exiting", , "PivotField Not Visible"
        Else
            'Check that at least one of the PivotItems exist in the PivotField
            For lPivotItemListIndex = LBound(aryPivotItemList) To UBound(aryPivotItemList)
                For lPIIndex = 1 To .PivotFields(sPivotField).PivotItems.Count
                    If UCase(.PivotFields(sPivotField).PivotItems(lPIIndex).Name) = aryPivotItemList(lPivotItemListIndex) Then
                        bFound = True   'Found one
                        .PivotFields(sPivotField).PivotItems(lPIIndex).Visible = True   'Make it visible
                        Exit For
                    End If
                    If bFound Then Exit For
                Next
            Next
            If bFound Then
                For lPIIndex = 1 To .PivotFields(sPivotField).PivotItems.Count
                    sPI = UCase(.PivotFields(sPivotField).PivotItems(lPIIndex).Name)
                    Debug.Print sPI
                    For lPivotItemListIndex = LBound(aryPivotItemList) To UBound(aryPivotItemList)
                        If aryPivotItemList(lPivotItemListIndex) = sPI Then
                            bInList = True
                            Exit For
                        End If
                    Next
                    If bInList Then
                        .PivotFields(sPivotField).PivotItems(lPIIndex).Visible = True
                        bInList = False
                     Else
                        .PivotFields(sPivotField).PivotItems(lPIIndex).Visible = False
                    End If
                Next
            Else
                MsgBox "No element of " & sPivotItemList & " PivotItem(s) exists in the " & sPivotField & " PivotField.  Exiting", , "PivotItem(s) Not Found"
            End If
        End If
    
    End With
    
End_Sub:
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Having trouble with pivot table macro
2
Replies
12
Views
379
RoryA
RoryA
S
  • Question Question
Macro for
Replies
2
Views
120
Sanderb
S
S
  • Question Question
Help with Pivot Table Macro
Replies
0
Views
64
SCPbrito
S
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
273
Jette3173
J
D
  • Question Question
VBA Coding for adding Pivot Table with changing data table
Replies
6
Views
267
darmst24
D

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top