VBA - Pivot table - Macro tweak

dstepan

Board Regular
Joined
Apr 16, 2009
Messages
160
Hi Everyone
I am trying to make this workbook fully automated as the user is not Excel savvy.
Also, I am still learning to code so much of what I have here is by "Record macro"
I have two problems I was hoping to get help on.
Problem 1:
I have a new workbook with Sheet1 which is copied from another workbook.
Sheet1 is my data for creating 4 pivot tables.
My data range can change monthly.
Last month I had 170 lines of data (a1:k170). Not including the tiltles and totals.
This month I have 173 lines of data (a1:k173). Not including the titles and totals.
Currently, I am only trying to work with the first pivot to try to get it adjust the data source.
However, the pivot data range is not refreshing when I recreate the pivot table sheets.
I searched everywhere for something that I could replicate.
Of which I did find and tweaked and saved as a Macro "AdjustDataSource
**I called the "AdjustDataSource" macro on line 20 of my "OrderBacklog3FinalwPivots" macro
This does not work. It is failing to pick up the extra 3 lines of data.
Any ideas on how to get the data source to update.
Problem 2:
My Sheet3 pivot table is to filter the customer list consisting of the same 4 customers each month.
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.
Originally, when using the Macro Recorder, all the customers not selected where listed with a "FALSE" notation.
IE: .PivotItems("XYZ").Visible = False *****
This also was not updating, so I thought I could write the reverse and list the customers I needed and notate them as "TRUE"
Below you will find the code
Any suggestions on either of these issue will help immensely.

<colgroup><col span="7"></colgroup><tbody>
</tbody>
Rich (BB code):
Rich (BB code):

<colgroup><col></colgroup><tbody>
Rich (BB code):
Rich (BB code):
[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]
Rich (BB code):
Rich (BB code):
[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>
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,810
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
 

Watch MrExcel Video

Forum statistics

Threads
1,101,748
Messages
5,482,625
Members
407,354
Latest member
Calvince

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top