password to restrict drilldown

Hi I have been given this VBA which perfectly restricts the use of drill-down in a pivot-table, however I found that is only works on the worksheet that the code is in Is there anyway to sort it so it works on any pivot-table within the workbook file ?

Sorry, but I am a new user on VBA !

Sub RestrictPTuse()
Dim p As PivotField
With Sheets("table").PivotTables("PivotTable1")
.EnableDrilldown = False
.EnableWizard = False
.PivotCache.EnableRefresh = True
For Each p In .PivotFields
p.DragToData = False
p.DragToHide = False
p.DragToColumn = False
p.DragToRow = False
p.DragToPage = False
Next p
End With
End Sub

Thanks for your help
Amy xx

Hi Amy!

I am giving you two versions of the macro. I wasn't sure it you wanted to run the macro once and apply this to all pivot tables in the workbook or be able to select the pivot table and worksheet when the macro is called.


Run Once to Apply to All Pivot Tables:

Sub RestrictPTuse()

Dim p As PivotField
Dim I As Integer
Dim J As Integer

For I = 1 To Excel.Worksheets.Count
For J = 1 To Excel.PivotTables.Count
With Sheets(I).PivotTables(J)
.EnableDrilldown = False
.EnableWizard = False
.PivotCache.EnableRefresh = True
For Each p In .PivotFields
p.DragToData = False
p.DragToHide = False
p.DragToColumn = False
p.DragToRow = False
p.DragToPage = False
Next p
End With
Next J
Next I

End Sub


Ask for Worksheet and Pivot Table Name:

Sub RestrictPTuse()

Dim p As PivotField
Dim WksName As String
Dim PvtName As String

WksName = InputBox("Enter the Name of the Worksheet in the Box Below.")
If WksName = "" Then Exit Sub

PvtName = InputBox("Enter the Name of the Pivot Table in the Box Below.)
If PvtName = "" Then Exit Sub

With Sheets(WksName).PivotTables(PvtName)
.EnableDrilldown = False
.EnableWizard = False
.PivotCache.EnableRefresh = True
For Each p In .PivotFields
p.DragToData = False
p.DragToHide = False
p.DragToColumn = False
p.DragToRow = False
p.DragToPage = False
Next p
End With

End Sub

The choice is yours!
Leith Ross

Hi Leith, thank you for the emails, I have a problem however:

When I run the code, I get a compile error "method or data member not found" ?
Can you help please ?

Amy xx

Hi Amy,

Which macro did you run? Can you tell me which line in the code is causing the problem?

Thanks,
Leith Ross

Hi Leith

Sub RestrictPTuse()

Dim p As PivotField
Dim I As Integer
Dim J As Integer

For I = 1 To Excel.Worksheets.Count
For J = 1 To Excel.PivotTables.Count -- this line is causing the error.
With Sheets(I).PivotTables(J)
.EnableDrilldown = False
.EnableWizard = False
.PivotCache.EnableRefresh = True
For Each p In .PivotFields
p.DragToData = False
p.DragToHide = False
p.DragToColumn = False
p.DragToRow = False
p.DragToPage = False
Next p
End With
Next J
Next I

End Sub

Line "For J = 1 To Excel.PivotTables.Count" is causing the error

Amy xx

Hi, I am using Visual Basic v 6.3 if that helps ?!

I have tried changing the line to "For J = 1 To Excel.xlPivotTable.Count" of similar but I cant get it to work !

Amy xx

Hi Amy,

My mistake. I assumed there was a Pivot Table on each Worksheet. The "J" loop needs to placed inside an IF statement that tests if the Worksheet has any Pivot Tables. Here is the correction.

Corrected Code:

Sub RestrictPTuse()

Dim p As PivotField
Dim I As Integer
Dim J As Integer

For I = 1 To Excel.Worksheets.Count

If Worksheets(I).PivotTables.Count <> 0 Then

For J = 1 To Excel.PivotTables.Count
With Sheets(I).PivotTables(J)
.EnableDrilldown = False
.EnableWizard = False
.PivotCache.EnableRefresh = True
For Each p In .PivotFields
p.DragToData = False
p.DragToHide = False
p.DragToColumn = False
p.DragToRow = False
p.DragToPage = False
Next p
End With
Next J

End If

Next I

End Sub

Sincerely,
Leith Ross