Pivot Table not displaying refreshed data

[mikeymay]

I have a pivot table (1 of 3) that is using a dynamic range as its source data.

The two other pivot tables, when having a new data set as the source data, display the correct data as per a pivot table should, but one of the pivot tables just refuses to show the refreshed data.

When I rebuild the table by creating a new pivot tale, it shows the correct data but when then a new data set is used as the data source, it looks like it is retaining the data it was displaying previously.

I have tried refreshing, changing the retained data to none but nothing other than creating a new pivot table seems to work.

The data to be used as the data source is added via a macro and needs to be fully automated so I can't use any workarounds that require the user to do anything to make it work.

Any advice would be hugely appreciated as I have no idea why Excel is acting like a petulant teenager!!??

 

[mikeymay]

Module in which the offending line sits

The specific line is in BOLD

I have tested this by manually changing the filter in the Pivot Table and it also stops Excel dead.

Both via the code and manually, no error message appears - Excel just stope and when I click on the app window, it fades a bit and I have to click on the X and Quit the application or quit via Task Manager.

I am just trying some where the filter is actually a pivot field and the code selects the item, a bit of a pain as you have to loop through all the items to unselect unless the item name matches what I want - Not quite as simple as the one line needed for the filters when they aren't being a d*ck....

Sub IndividualOutput()

Dim rngCopy As Range
Dim rngPaste As Range
Dim rngVRTList As Range
Dim rngCell As Range

Dim strPerson As String
Dim strVRTType As String

Dim intVRTCount As Integer
Dim intTypeCount As Integer

Dim boolOutput As Boolean

Do Until rngPerson = ""
   boolOutput = False
        
   Select Case strRole
      Case "ASM"
         If rngPerson.Offset(0, intRoleCol) = strRole And rngPerson.Offset(0, intRoleCol + 1) <> "RSD" And rngPerson.Offset(0, intLevelCol) = strLevel Then
            boolOutput = True
            Else
         End If
      
      Case "BDM"
         If rngPerson.Offset(0, intRoleCol) = strRole And Left(rngPerson.Offset(0, intRoleCol + 1), 3) = strRole And rngPerson.Offset(0, intLevelCol) = strLevel Then
            boolOutput = True
            Else
         End If
      
      Case "RAM"
         If rngPerson.Offset(0, intRoleCol) = strRole Then
            boolOutput = True
            Else
         End If
      
   End Select
   
   If boolOutput = True Then
      strPerson = rngPerson
      
      If WorksheetFunction.CountIf(Range("D_DataCOCol"), strPerson) = 0 Then
         Else
[B][U][I]         Sheets("PT").PivotTables("ptPersonList").PivotFields("Class. Owner").CurrentPage = strPerson[/I][/U][/B]
         
         'Populate list
         Set rngVRTList = Range("PT_ListStart").Offset(1, 0)
         Set rngCopy = rngVRTList.Offset(0, 1)
         
         intVRTCount = 1
         intTypeCount = 0
         
         Do Until rngVRTList.Offset(intVRTCount, 1) = ""
            strVRTType = rngVRTList.Offset(intVRTCount - 1, 0)
            
            'Get VRT type
            Select Case strVRTType
               Case "OK"
                  Set rngPaste = Range("Lists_StartOK").Offset(0, 1)
               
               Case "Planned"
                  Set rngPaste = Range("Lists_StartPlanned").Offset(0, 1)
               
               Case "Overdue"
                  Set rngPaste = Range("Lists_StartOverdue").Offset(0, 1)
               
               Case Else
               
            End Select
                        
            'Find last type row
            intTypeCount = 0
            
            Do Until (rngVRTList.Offset(intVRTCount, 0) <> "" And rngVRTList.Offset(intVRTCount, 0) <> strVRTType) Or rngVRTList.Offset(intVRTCount, 1) = ""
               intTypeCount = intTypeCount + 1
               
               intVRTCount = intVRTCount + 1
            Loop
            
            'Paste into Lists sheet
            If intTypeCount = 0 Then
               Else
               wsLists.Activate
               
               Range(rngPaste.Offset(1, 0), rngPaste.Offset(intTypeCount, 4)).EntireRow.Insert Shift:=xlDown
               
               Set rngCopy = Range(rngCopy, rngCopy.Offset(intTypeCount, 4))
               
               Set rngPaste = Range(rngPaste, rngPaste.Offset(rngCopy.Rows.Count - 1, 4))
               
               rngPaste.Value = rngCopy.Value
               
               rngPaste.Select
               
               'Fill in borders
               With Selection
                  .Borders(xlInsideHorizontal).LineStyle = xlContinuous
                  .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic
                  .Borders(xlInsideHorizontal).TintAndShade = 0
                  .Borders(xlInsideHorizontal).Weight = xlThin
                  
                  'Get rid of balnk values
                  For Each rngCell In .Cells
                     If rngCell = "(blank)" Then
                        rngCell = ""
                        Else
                     End If
                  Next
                  
                  Set rngCell = Nothing
               End With
            End If
                                                
            If intTypeCount <= 1 Then
               Else
               'Sort by
               With wsLists.Sort
                  .SortFields.Clear
                  
                  .SortFields.Add Key:=Range("D" & rngPaste.Cells(1).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("C" & rngPaste.Cells(1).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
                  .SetRange Range(rngPaste.Address)
   
                  .Header = xlNo
                  .MatchCase = False
                  .Orientation = xlTopToBottom
                  .SortMethod = xlPinYin
                  .Apply
               End With
            End If
                       
            Set rngPaste = Nothing
            
            Set rngCopy = rngVRTList.Offset(intVRTCount, 1)
            
            intVRTCount = intVRTCount + 1
         Loop
         
         Set rngVRTList = Nothing
         
         Calculate
         
         'Hide any rows with no data
         If Range("Lists_CountOK") = 0 Then
            Range("Lists_RowsOK").EntireRow.Hidden = True
            Else
         End If
         
         If Range("Lists_CountPlanned") = 0 Then
            Range("Lists_RowsPlanned").EntireRow.Hidden = True
            Else
         End If
         
         If Range("Lists_CountOverdue") = 0 Then
            Range("Lists_RowsOverdue").EntireRow.Hidden = True
            Else
         End If
         
         'Sub role
         'Export charts
         Sheets("Charts").Activate
         
         strFilename = Trim(strFolder & "\" & strLevelAbb & "\" & strPerson & "\" & intPageNo & ".1 VRT " & strLevel) & ".pdf"
         
         If strRole = "RAM" Then
            Set chtChart = wsCharts.ChartObjects("chtInd")
            
            For Each srsSeries In chtChart.Chart.SeriesCollection
               If srsSeries.Name = "Overdue" Then
                  srsSeries.Format.Fill.ForeColor.RGB = RGB(intR, intG, intB)
                              
                  If BoolWhiteF = True Then
                     srsSeries.DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
                     Else
                     srsSeries.DataLabels.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
                  End If
                  Else
               End If
            Next
            Else
         End If
         
         chtChart.Activate
         ActiveChart.Legend.Select
         Selection.Width = 830
         
         Range("A1").Select
         
         Sheets("Admin").Activate
         
         wsCharts.PageSetup.PrintArea = Range(strPrintI).Address
         
         wsCharts.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=strFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
         
         'Export list
         strFilename = strFolder & "\" & strLevelAbb & "\" & strPerson & "\" & intPageNo & ".2 VRT " & strPerson & ".pdf"
         
         wsLists.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=strFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
         
         'Head copy
         If strHeadPerson = "" Then
            Else
            strFilename = strFolder & "\" & strLevelAbb & "\" & strHeadPerson & "\" & intPageNo & ".1 VRT " & strPerson & ".pdf"
         
            wsLists.ExportAsFixedFormat Type:=xlTypePDF, _
               Filename:=strFilename, _
               Quality:=xlQualityStandard, _
               IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=False
         End If
   
         'Clear dwon
         wsLists.Range("Print_Area").EntireRow.Hidden = False
         
         wsLists.Activate
         
         'OK
         If Range("Lists_CountOK") <= 1 Then
            Else
            Range(Range("Lists_StartOK").Offset(1, 1), Range("Lists_StartOK").Offset(Range("Lists_CountOK") - 1, 5)).Select
            
            Range(Range("Lists_StartOK").Offset(1, 1), Range("Lists_StartOK").Offset(Range("Lists_CountOK") - 1, 5)).EntireRow.Delete
         End If
   
         Range(Range("Lists_StartOK").Offset(0, 1), Range("Lists_StartOK").Offset(0, 5)).ClearContents
         
         'Planned
         If Range("Lists_CountPlanned") <= 1 Then
            Else
            Range(Range("Lists_StartPlanned").Offset(1, 1), Range("Lists_StartPlanned").Offset(Range("Lists_CountPlanned") - 1, 5)).Select
            
            Range(Range("Lists_StartPlanned").Offset(1, 1), Range("Lists_StartPlanned").Offset(Range("Lists_CountPlanned") - 1, 5)).EntireRow.Delete
         End If
         
         Range(Range("Lists_StartPlanned").Offset(0, 1), Range("Lists_StartPlanned").Offset(0, 5)).ClearContents
         
         'Overdue
         If Range("Lists_CountOverdue") <= 1 Then
            Else
            Range(Range("Lists_StartOverdue").Offset(1, 1), Range("Lists_StartOverdue").Offset(Range("Lists_CountOverdue") - 1, 5)).Select
            
            Range(Range("Lists_StartOverdue").Offset(1, 1), Range("Lists_StartOverdue").Offset(Range("Lists_CountOverdue") - 1, 5)).EntireRow.Delete
         End If
         
         Range(Range("Lists_StartOverdue").Offset(0, 1), Range("Lists_StartOverdue").Offset(0, 5)).ClearContents
         
         Calculate
      End If
      Else
   End If
   
   Set rngPerson = rngPerson.Offset(1, 0)
Loop

Set rngCopy = Nothing
Set rngPaste = Nothing

End Sub

 

[mikeymay]

The following seems to be working and whilst it's solved the problem, I don't like the fact that what shoudl work, isn't

Naughty Excel....

         Dim ptList As PivotTable
         Dim pfPeople As PivotField
         Dim piPerson As PivotItem
        
         Dim rngList As Range
         Dim strMsg As String

         Set ptList = Sheets("PT").PivotTables("ptPersonList")
   
         Set pfPeople = ptList.PivotFields("Class. Owner")
        
         pfPeople.PivotItems(strPerson).Visible = True

         For Each piPerson In pfPeople.PivotItems
            If piPerson.Caption = strPerson Then
               Else
               piPerson.Visible = False
            End If
         Next