Password protection with exceptions

[K. Georgiadis]

I have been using the following code to protect all worksheets in a workbook:

Public Sub ProtectAll() 
 Const PWORD As String = "mysecretword" 
 Dim wsSheet As Worksheet 
 For Each wsSheet In Worksheets 
 wsSheet.Protect Password:=PWORD 
 Next wsSheet 
 End Sub

This password protects all sheets without exceptions.

Is there any way to modify the code so that, while it protects all sheets, it universally allows editing of objects, autofilter, and Pivot reports?

[Jacob Hilderbrand]

Try this.

Option Explicit

Public Sub ProtectAll()
Const PWORD As String = "mysecretword"
Dim wsSheet As Worksheet
For Each wsSheet In Worksheets
        wsSheet.Protect Password:=PWORD, DrawingObjects:=False, _
        Contents:=True, Scenarios:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    Next wsSheet
End Sub

[K. Georgiadis]

Thank you. I'll give it a try and will mark the post "SOLVED" if it works for me.

[Jacob Hilderbrand]

You're Welcome

Let me know if there are any problems.

Take Care

[K. Georgiadis]

thanks, DRJ. This works! I marked the thread "solved."

[K. Georgiadis]

to DRJ: as I said this works. However, I have a curiosity question regarding syntax: why is DrawingObjects marked "False", whereas all the other exceptions are marked "True?"

[Jacob Hilderbrand]

DrawingObjects is False so that they are not protected.
AllowUsingPivotTables is True so that Using Pivot Tables is allowed.

[K. Georgiadis]

I got it. In the meantime, I encountered the following problem when using the code:

On opening the file, I get an error which seems to be based on the fact that the Pivot Table is set to auto-refresh when opening the workbook (set at Table Properties). Therefore, I have to go to the worksheet that contains the Pivot Table and manually remove all worksheet protection. Is there a workaround for this?

[Jacob Hilderbrand]

Try this.

Option Explicit
 
Public Sub ProtectAll()
Const PWORD As String = "mysecretword"
Dim wsSheet As Worksheet
For Each wsSheet In Worksheets
        wsSheet.Protect Password:=PWORD, DrawingObjects:=False, _
        Contents:=True, Scenarios:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True, UserInterfaceOnly:=True
    Next wsSheet
End Sub

If that doesn't work can you post an attachment that shows the error?

[K. Georgiadis]

Unfortunately, it does not work unless I clear the "automatically refresh" option in the Pivot Table options. The file is 4 megs large, therefore attaching it is not an option. For now, I'll just go to the Pivot Table worksheet and clear the protection manually. At least, I don't have to protect manually the other 69 worksheets!

[K. Georgiadis]

Further to the above, I saw the following VBA code by Debra Dalgleish that supposedly unprotects the Pivot table, refreshes it, and protects it again (I said "supposedly" because I have not tried it myself). I'm wondering if there is a way to combine your code and hers in some fashion:

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim pt As PivotTable
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect Password:="MySecretWord"
For Each pt In ws.PivotTables
pt.RefreshTable
Next
ws.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True, _
Password:="MySecretWord"
Next
End Sub

I suppose this code would have to be placed in "This workbook?"

[Jacob Hilderbrand]

Yes, the Workbook_Open event code must be placed in the ThisWorkbook module.