VBA - Pivot table - Macro tweak
Results 1 to 2 of 2

Thread: VBA - Pivot table - Macro tweak
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Apr 2009
    Location
    NE USA
    Posts
    160
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA - Pivot table - Macro tweak

    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.
    Code:
    Sub OrderBacklog3FinalwPivots()
    '
    ' OrderBacklog3FinalwPivots Macro
    Sheets("Sheet1").Columns("G:K").Copy
    Sheets("Sheet1").Columns("G:K").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWorkbook.SaveAs Filename:="H:\Accounting\ABC Services Inc\Accounting\Month End Financial Close\2019 Month End Close\ORDER BACKLOG PREP.xlsx", _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy
    ChDir _
    "H:\Accounting\ABC Services Inc\Accounting\Month End Financial Close\2019 Month End Close"
    ActiveWorkbook.SaveAs Filename:= _
    "H:\Accounting\ABC Services Inc\Accounting\Month End Financial Close\2019 Month End Close\Order Backlog.xlsm" _
    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Range("B12").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Sheet1!R1C1:R170C11", Version:=6).CreatePivotTable TableDestination:= _
    "Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet2").Select
    Cells(3, 1).Select
    Call AdjustDataSource
    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
    Call AdjustDataSource
    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("Ext Price"), "Sum of Ext Price", xlSum
    Columns("B:B").Select
    Selection.Style = "Comma"
    Sheets("Sheet1").Select
    Sheets.Add
    ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").PivotCache. _
    CreatePivotTable TableDestination:="Sheet3!R3C1", TableName:="PivotTable2" _
    , DefaultVersion:=6
    Sheets("Sheet3").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
    Range("B10").Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Quarter")
    .Orientation = xlRowField
    .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
    "PivotTable2").PivotFields("Ext Price"), "Sum of Ext Price", xlSum
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
    "PivotTable2").PivotFields("Profit"), "Sum of Profit", xlSum
    Columns("B:C").Select
    Selection.Style = "Comma"
    Sheets("Sheet1").Select
    Sheets.Add
    ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").PivotCache. _
    CreatePivotTable TableDestination:="Sheet4!R3C1", TableName:="PivotTable3" _
    , DefaultVersion:=6
    Sheets("Sheet4").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable3")
    .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("PivotTable3").PivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable3").RepeatAllLabels xlRepeatLabels
    Range("C11").Select
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Customer")
    .Orientation = xlRowField
    .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Customer")
    .Orientation = xlPageField
    .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable3").PivotFields("Quarter")
    .Orientation = xlRowField
    .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
    "PivotTable3").PivotFields("Ext Price"), "Sum of Ext Price", xlSum
    ActiveSheet.PivotTables("PivotTable3").AddDataField ActiveSheet.PivotTables( _
    "PivotTable3").PivotFields("Profit"), "Sum of Profit", xlSum
    Columns("B:C").Select
    Selection.Style = "Comma"
    Sheets("Sheet3").Select
    Range("B5").Select
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer")
    .Orientation = xlPageField
    .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer").CurrentPage = _
    "(All)"
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer")
    .PivotItems("CDE").Visible = True *****
    .PivotItems("FGH").Visible = True *****
    .PivotItems("IJK").Visible = True *****
    .PivotItems("LMN").Visible = True *****
    End With
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Customer").CurrentPage = _
    "(All)"
    Columns("B:C").Select
    Selection.Style = "Comma"
    Sheets("Sheet1").Select
    Sheets.Add
    ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable1").PivotCache. _
    CreatePivotTable TableDestination:="Sheet5!R3C1", TableName:="PivotTable4" _
    , DefaultVersion:=6
    Sheets("Sheet5").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable4")
    .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("PivotTable4").PivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable4").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable4").PivotFields("Customer")
    .Orientation = xlRowField
    .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
    "PivotTable4").PivotFields("Ext Price"), "Sum of Ext Price", xlSum
    Columns("B:b").Select
    Selection.Style = "Comma"
    Sheets("Sheet1").Select
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet6").Select
    Sheets("Sheet6").Move Before:=Sheets(5)
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$1:$K$170").AutoFilter Field:=2, Criteria1:=Array( _
    "CDE", "FGH", "IJK", "LMN"), Operator:=xlFilterValues
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Sheet6").Select
    ActiveSheet.Paste
    Columns("A:A").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("G:K").Select
    Application.CutCopyMode = False
    With Selection
    .HorizontalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    ActiveWorkbook.Save
    End Sub
    Code:
    Sub AdjustDataSource()
    'PURPOSE: Automatically readjust a Pivot Table's data source range
    Dim Data_sht As Worksheet
    Dim StartPoint As Range
    Dim DataRange As Range
    Dim NewRange As String
    Set Data_sht = ThisWorkbook.Worksheets("Sheet1")
    Set StartPoint = Data_sht.Range("A1")
    Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
    NewRange = Data_sht.Name & "!" & _
    DataRange.Address(ReferenceStyle:=xlR1C1)
    End Sub

  2. #2
    Board Regular pbornemeier's Avatar
    Join Date
    May 2005
    Location
    Virginia Beach, VA USA
    Posts
    3,628
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    1 Thread(s)

    Default 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
    Phil

    - Use CODE tags to keep your code formatted. See: BB Tags
    - How to attach Screenshots
    - Try searching for your answer first, see how
    - Test and validate results for all code on a copy of your worksheet!! How do you use the code you just found?
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •