VBA - Macro Copied Workbook, Pivot Data Source not Updating

[DKoontz]

Hi all,

I'm writing a macro that takes a master file, takes a list of sales people, and for each sales person (RSL) creates individual copies of the master file and edits them so that they only see their own data. I've gotten everything to work but the only thing I haven't figured out is how to update the Pivot table data sources. When I make a copy of the workbook, the pivot data source stays linked to the original master instead of updating to the new workbook (which I am then editing). Is there any way to get around this? I've looked and a few different people are suggesting its an issue with pivot caches but I've had no luck with any fixes.

This is what the new workbook's pivot table data source points too, it points to the old master file rather than just the Sales table.

I'm still pretty new to VBA so any help is greatly appreciated. Feels so close to working properly.

As a quick runthrough of the macro it should, for each sales person in list on "graphs" tab > copy master > Delete sales region trending tab > delete everyone but that sales person from sales data > delete everyone but that sales person in hardware data > refresh all pivot tables > save as a copy in a desktop field tracings folder > close.

Side question: Does it matter where you define a DIM, in/outside a loop if its being changed each loop?

Here is the code I'm using (it still needs some work):

Sub CreateTracings()

Dim Graphs As Worksheet: Set Graphs = Sheets("Graphs")

Dim new_wb As Workbook
Dim UserName As String
Dim myFolder As String
Dim rslName As String
'Dim SalesRange As Range
'Dim HardwareRange As Range
Dim lastRow As Range

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Begin loop
'------------------------------------------------------------------------------|
For i = 1 To Graphs.Range("BA" & Graphs.Rows.Count).End(xlUp).Row
    On Error Resume Next
    
    rslName = Graphs.Range("BA" & i)
    
    'Copy workbook
    ActiveWorkbook.Sheets.Copy
    Set new_wb = ActiveWorkbook
    
    'Edit new workbook
    '*****************************************************
    'Delete Sales Region Trending Tab
    For Each Sheet In new_wb.Worksheets
         If Sheet.Name = "Sales Region Trending" Then
              Sheet.Delete
         End If
    Next Sheet
  
    'Filter and delete in Sales Data
    Dim SalesRange As Range
    Set SalesRange = ActiveWorkbook.Sheets("Sales Data-No Hardware").Range("B2:S" & [SalesData].Cells([SalesData].Rows.Count, 2).End(xlUp).Row)
    SalesRange.AutoFilter Field:=14, Criteria1:="<>" & rslName
    
    On Error Resume Next
        With SalesRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
            Err.Clear
    
    'Filter and delete hardware data
    Dim HardwareRange As Range
    Set HardwareRange = ActiveWorkbook.Sheets("Hardware Data").Range("A1:Q" & [HardwareData].Cells([HardwareData].Rows.Count, 1).End(xlUp).Row)
   HardwareRange.AutoFilter Field:=14, Criteria1:="<>" & rslName
    
    On Error Resume Next
        With HardwareRange
            .Offset(1).Resize(.Rows.Count - 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
            Err.Clear
    
    'Refresh all pivot tables
    Calculate
    ActiveWorkbook.RefreshAll
    
    'Saving tracing copy
    UserName = Environ("Username")
    myFolder = "C:\Users\" & UserName & "\Desktop\Field Tracings\"
    
    'Creates Field Tracings folder if missing
    If Dir(myFolder, vbDirectory) = "" Then
         MkDir myFolder
    End If
        
    'Saves Active workbook
    ActiveWorkbook.SaveAs Filename:="C:\Users\" & UserName & "\Desktop\Field Tracings\" & rslName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    'Close activeworkbook
    ActiveWorkbook.Close False
    
On Error GoTo 0
Next i
'------------------------------------------------------------------------------|
'End Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True
    
    
End Sub

Thank you so so much,

Drew