Password protection with exceptions

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

Code:

---

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?

Try this.

Code:

---

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

---

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

You're Welcome :beerchug:

Let me know if there are any problems.

Take Care

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

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?"

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

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?

Try this.

Code:

---

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?

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!

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:

Code:

---

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?"

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