VBA - Macro Copied Workbook, Pivot Data Source not Updating

DKoontz

New Member
Joined
Mar 29, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
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.
DKoontz_0-1627509644404.png

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):
VBA Code:
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
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

Forum statistics

Threads
1,148,257
Messages
5,745,700
Members
423,969
Latest member
CHHeights

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top