VBA Pivot Table Overlapping

junkforhr

Board Regular
Joined
Dec 16, 2009
Messages
83
Hi,

I've found the below code to display overlapping pivot tables, which will look at every pivot table in the file and then it will pop up messages where the overlapping pivot tables are.

Can someone please update the code to make it so I can select the sheet that to code checks (I was thinking of having a cell have the name of the sheet) and then out-put the results to a sheet called "Checking" in B5?

The reason I'm asking is, I've inherited a workbook, that has over 700 pivot tables (which are connected via powerpivot to various csv and excel files). These pivot tables are spread over 10 sheets and trying to locate the overlapping pivot tables is time consuming and hit and miss. I 've found a few manually, but there are a lot that I cannot locate manually. Also when the below code is run , it is coming up with the error Excel is waiting on for another application to complete an OLE action.

Hoping someone can update. Thanks to the person who wrote the original code.


VBA Code:
Sub PivotCheck()
'
' PivotCheck Macro
' Running this macro will refresh all the pivot tables in the workbook.
'IF there are errors, a window will pop up and tell you which pivot table and what worksheet is causing the error.
'Why excel does not do this automatically is a mystery. Party on.
'
Dim pt As PivotTable
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
On Error Resume Next
pt.PivotCache.Refresh
If Err <> 0 Then MsgBox "pivot table """ & pt.Name & """" & vbCr & _
"refresh error on " & vbCr & "worksheet """ & wks.Name & """"
Next pt
Next wks
Set pt = Nothing
Set wks = Nothing
'
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

mart37

Well-known Member
Joined
Aug 4, 2017
Messages
1,091
Office Version
  1. 2016
Platform
  1. Windows
VBA Code:
Sub PivotCheckt()
'
' PivotCheck Macro
' Running this macro will refresh all the pivot tables in the workbook.
'IF there are errors, a window will pop up and tell you which pivot table and what worksheet is causing the error.
'Why excel does not do this automatically is a mystery. Party on.
'
Dim pt As PivotTable
Dim wks As Worksheet
Dim wksC As Worksheet
Set wksC = Worksheets("Checking")
strSheetname = InputBox("Wich sheet?")
Set wks = Worksheets(strSheetname)
For Each pt In wks.PivotTables
    On Error Resume Next
    pt.PivotCache.Refresh
    If Err <> 0 Then
        lr = wksC.Range("A" & Rows.Count).End(xlUp).Row + 1
        wksC.Range("A" & lr) = "pivot table " & pt.Name & " refresh error on worksheet " & wks.Name
    End If
Next pt
Set pt = Nothing
Set wks = Nothing
'
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,806
Messages
5,638,472
Members
417,026
Latest member
UDK

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