Change Data Source Range for ALL Pivot Tables that are Using a Particular Named Range Within Excel via VBA

0 votes

I'm attempting to switch the named range BDATA used by all of the pivot tables in a workbook to the named range SDATA. All of the pivot tables in the workbook's source could be changed, however, this isn't what I need because other pivot tables I have different named ranges.

This is the code that I used, which was extracted from this link: https://www.contextures.com/excelpivottabledatasource.html

Sub PivotSourceChangeAll_Ranges()
'for normal pivot tables only
'not for OLAP-based (e.g. Data Model)
'lists all named ranges
Dim wb As Workbook
Dim ws As Worksheet
Dim wsList As Worksheet
Dim pt As PivotTable
Dim strSD As String
Dim strMsg As String
On Error Resume Next
Application.DisplayAlerts = False
Application.EnableEvents = False

Set wb = ActiveWorkbook
Set wsList = Worksheets.Add

With wsList
.Range("A1").ListNames
.Columns(2).ClearContents
.Columns(1).EntireColumn.AutoFit
End With

strMsg = "Enter one of the Source Data Range Names "
strMsg = strMsg & vbCrLf & "from list shown on worksheet"

strSD = InputBox(Prompt:=strMsg, Title:="Source Data")
If strSD = "" Then
  MsgBox "Cancelled"
  Exit Sub
Else
  For Each ws In wb.Worksheets
    For Each pt In ws.PivotTables
      pt.ChangePivotCache _
        wb.PivotCaches.Create(SourceType:=xlDatabase, _
              SourceData:=strSD)
    Next pt
  Next ws
End If

exit_Handler:
  wsList.Delete
  Application.EnableEvents = True
  Application.DisplayAlerts = True
  Exit Sub
err_Handler:
  MsgBox "Could not update pivot table source data"
  Resume exit_Handler
End Sub

Any help would be much appreciated.

Jan 7 in Others by Kithuzzz
• 28,900 points
73 views

1 answer to this question.

0 votes

Try this:

Sub Tester()
    Dim wb As Workbook, ws As Worksheet, pt As PivotTable, pc As PivotCache
    Dim src As String
    
    Set wb = ThisWorkbook

    For Each ws In wb.Worksheets
        For Each pt In ws.PivotTables
            src = pt.PivotCache.SourceData
            If src = "BDATA" Then
                pt.PivotCache.SourceData = "SDATA"
                Debug.Print "replaced source"
            End If
        Next pt
    Next ws
End Sub
answered Jan 7 by narikkadan
• 53,520 points

Related Questions In Others

0 votes
1 answer

Use Excel pivot table as data source for another Pivot Table

Press the keys Alt+D+P in a new ...READ MORE

answered Nov 11, 2022 in Others by narikkadan
• 53,520 points
590 views
0 votes
1 answer
0 votes
1 answer

How to increment the Range of a For Each loop - Excel VBA

Your formula seems to sum 1 single ...READ MORE

answered Jan 7 in Others by narikkadan
• 53,520 points
82 views
0 votes
1 answer

Is there a way to test a formula result in excel and type it only once, all within one cell and not using a user defined function?

Use the Let function: =LET(Value,A1+B2+C4+G3+B4,IF(Value>10,"No",Value)) I hope this helps ...READ MORE

answered Jan 9 in Others by narikkadan
• 53,520 points
41 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
533 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
2,415 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 22,960 points
117 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,630 points
300 views
0 votes
1 answer
0 votes
1 answer

Using Visual Basic to pull data from within a range to use in an Excel function

Use AVERAGEIFS instead of the full range. ...READ MORE

answered Jan 14 in Others by narikkadan
• 53,520 points
40 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP