drill down secured pivot table

[ThomasPL]

Hi there!

Is there a way to allow the users the capability to drill down a pivot table in a secured workbook?

I’ve managed to build a macro to protect/unprotect my report but end users are unable to get detailed data out of final pivot table when it’s in secured mode.

 

[Chihiro]

You can do something like below. However, user will not be able to delete the expanded sheet. You will need to add another routine (tied to Button control, Workbook_BeforeClose event, etc) to delete generated worksheets.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim pvt As PivotTable
Dim ws As Worksheet, wb As Workbook

Set ws = Target.Parent
Set wb = ThisWorkbook
ws.Unprotect "Your Password"
wb.Unprotect "Your Password"

On Error Resume Next
Cancel = True

Set pvt = Target.PivotTable

On Error GoTo 0
If pvt Is Nothing Then
    MsgBox "Click on valid PivotTable Data range"
    Exit Sub
End If

Selection.ShowDetail = True

ws.Protect "Your Password"
wb.Protect "Your Password"
End Sub

 

[ThomasPL]

Thank you @Chihiro. I'll try to go this way (with using an event) but perhaps you'll see easily why it doesn't work in my case. Below pelase find my code for protecting the seet.

Sub ProtectAll()
  Dim S As Object
  Dim stocks As Worksheet
  Dim pWord1 As String, pWord2 As String
  Dim answer As Integer
  Dim OutPut1, OutPut2 As Integer

  answer = MsgBox("Protect this workbook?", vbYesNo + vbQuestion)
  If answer = vbNo Then Exit Sub Else

  pWord1 = InputBox("Please enter the password")
  If pWord1 = "" Then Exit Sub
  pWord2 = InputBox("Please re-enter the password")

  If pWord2 = "" Then Exit Sub

  If InStr(1, pWord2, pWord1, 0) = 0 Or _
  InStr(1, pWord1, pWord2, 0) = 0 Then
  OutPut1 = MsgBox("  You entered different passwords." & vbCrLf & "  No action taken!", vbExclamation, "Error!")
  Exit Sub
  End If

  Application.ScreenUpdating = False

  Range("E1,G1,I1,K1,M1").Select
  Selection.EntireColumn.Hidden = True
  Range("N1").Select

  Sheets("data").Select
  ActiveWindow.SelectedSheets.Visible = False
  Sheets("stocks").Select

  Application.ScreenUpdating = True

  For Each ws In Worksheets
  ws.Protect Password:=pWord1
  Next
  OutPut2 = MsgBox("Workbook is protected!", vbInformation)

  Exit Sub

End Sub

Please note I'm not advanced VBA user
In your code I've set password given via inputbox while protecting the workbook but still I'm unable to drill down PT (as ws/wb.unprotect didn't work).

 

[Chihiro]

Make sure that the code is in the Worksheet module of the sheet containing PivotTable. Other than that, if you need specific help, it would help if you can upload sample file with dummy data.

 

[ThomasPL]

That's it (locating code in proper WS module).
Thank you!