Hello everyone,

I hoping to get some help with a code error that I get only sometimes when running the macro. While at other times the code works great. A little frustrating...

The error:
Run-time error '1004':

The PivotTable report was saved without the underlying data. Use the Refresh Data command to update the report.
The error occurs at this line: 
.RemovePivotTable (PT)
Please see the red, bolded, underlined, and italicized part of the code below. (Note this code is slightly modified from Jerry Sullivan's code.)

The purpose of the macro:
Change the data source of the pivot tables in a workbook, while keeping the same slicer connections.




Code:
Sub Change_SourceData_Of_MultipleSlicer_Connected_Pivots2()
'---changes source data of pivots connected to specified slicers
Dim dicPivotIDs As Object
Dim vSlicers() As Variant, vSlicerList() As Variant, vKey As Variant
Dim PT As PivotTable, PT1 As PivotTable
Dim sPivotID As String, sNewSource As String
Dim iSlicer As Long, iPivot As Long, lItem As Long
Dim activeBOOKname As String
Dim ws As Worksheet


Set wbd = ThisWorkbook

Dim path As String
path = Application.Run("'PortalPMT.xlsm'!dataReg_Area", 5, 4)

Dim path22 As String
path22 = Application.Run("'PortalPMT.xlsm'!dataReg_Area22", 5, 4)

Dim path33 As String
path33 = Application.Run("'PortalPMT.xlsm'!dataReg_Area33", 5, 4)

'--edit list of slicers. They must share the same PivotCache.
vSlicerList = Array("Slicer_Office", "Slicer_Week", "Slicer_Name", "Slicer_Name1")

'--edit with range reference to new PivotCache datasource

sNewSource = path22



Set dicPivotIDs = CreateObject("Scripting.Dictionary")
ReDim vSlicers(LBound(vSlicerList) To UBound(vSlicerList))

'--build array of arrays mapping each Slicer's connected PivotTables
For iSlicer = LBound(vSlicerList) To UBound(vSlicerList)
   With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
      If .Count Then
         ReDim vPivots(1 To .Count)
         For iPivot = .Count To 1 Step -1
            Set PT = .Item(iPivot)
            Set vPivots(iPivot) = PT
            .RemovePivotTable (PT)
            '--add unique pivot identifiers to dictionary
            sPivotID = "'" & PT.Parent.Name & "'!" & _
               PT.TableRange1.Cells(1).Address
            If Not dicPivotIDs.Exists(sPivotID) Then
               lItem = lItem + 1
               dicPivotIDs.Add sPivotID, lItem
            End If
         Next iPivot
         vSlicers(iSlicer) = vPivots
      End If
   End With
Next iSlicer

activeBOOKname = GetBook

'---change datasource of all pivots

Workbooks.Open Filename:=path

Workbooks(activeBOOKname).Activate

For Each ws In Worksheets

    ws.Unprotect

Next ws


For Each vKey In dicPivotIDs.Keys
   If PT1 Is Nothing Then
      Set PT1 = Range(vKey).PivotTable

      PT1.ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
            SourceData:=sNewSource)
            
            Else
      Range(vKey).PivotTable.CacheIndex = PT1.CacheIndex
   End If
Next vKey

ThisWorkbook.RefreshAll

For Each ws In Worksheets

    ws.Protect , UserInterfaceOnly:=True, AllowUsingPivotTables:=True

Next ws

Workbooks(path33).Close SaveChanges:=False

'--reconnect Pivots to Slicers using stored mapping
For iSlicer = LBound(vSlicers) To UBound(vSlicers)
   If Not IsEmpty(vSlicers(iSlicer)) Then
      With ActiveWorkbook.SlicerCaches(vSlicerList(iSlicer)).PivotTables
         For iPivot = LBound(vSlicers(iSlicer)) To UBound(vSlicers(iSlicer))
            .AddPivotTable vSlicers(iSlicer)(iPivot)
         Next iPivot
      End With
   End If
Next iSlicer



MsgBox "The PivotTables' data source have been updated"

Exit Sub
ErrHandler:
   MsgBox Err.Number & ": " & Err.Description
End Sub
Any suggestions?

Thanks!

Geoff.