VBA to password protect all sheets

[Coppa]

I am trying to run a script to pass protect all sheets and then give a message box saying either Password correct, or incorrect. The script to actually protect the sheets works well, its the msg boxes which are driving me up the wall. My script is below with the headache area highlighted in green.

Thanks


Sub ProtectAll()
Application.ScreenUpdating = False
Dim wSheet As Worksheet
Dim Pwd As String

Pwd = InputBox("Enter your password to protect all worksheets", "Password Input")
For Each wSheet In Worksheets
wSheet.Protect Password:=Pwd
Next wSheet
If Err <> 0 Then
MsgBox "You have entered an incorect password. All worksheets could not " & _
"be protected.", vbCritical, "Incorect Password"
Else
MsgBox "All worksheets protected"
End If
On Error GoTo 0

Application.ScreenUpdating = True
End Sub

Sub UnProtectAll()
Application.ScreenUpdating = False
Dim wSheet As Worksheet
Dim Pwd As String

Pwd = InputBox("Enter your password to unprotect all worksheets", "Password Input")
On Error Resume Next
For Each wSheet In Worksheets
wSheet.Unprotect Password:=Pwd
Next wSheet
If Err <> 0 Then
MsgBox "You have entered an incorect password. All worksheets could not " & _
"be unprotected.", vbCritical, "Incorect Password"
Else
MsgBox "All worksheets protected"
End If
On Error GoTo 0
Application.ScreenUpdating = True
End Sub

 

[GTO]

I only stepped thru the Unprotect sub twice (once w/good pwd and once w/bad). What is it not doing?

 

[Coppa]

When you run the protect script, it always says sheets are protected, even if the password is wrong, and similarily for unprotect. I want it to say "sheet not protected"if the pass is wrong, and also say "sheet not unprotected"if there is an the pass entry is wrong

 

[GTO]

You may wish to manually unprotect all the sheets to ensure you do not have an errant pwd. I ran and it seems to run fine, although the msgbox says that they are all protected (rather than unprotected).

That said, you could change it a bit so that it doesn't need to run through all the sheets, if it finds and incorrect pwd early.

Sub UnProtecAll()
Dim wSheet As Worksheet
Dim sPwd As String
    
    sPwd = InputBox("", "")
    On Error GoTo errHndl
    For Each wSheet In ThisWorkbook.Worksheets
        wSheet.Unprotect sPwd
    Next
    
    MsgBox "All sheets unprotected."
Exit Sub
errHndl:
    MsgBox """" & sPwd & """ is incorrect"
End Sub

 

[Coppa]

You may wish to manually unprotect all the sheets to ensure you do not have an errant pwd. I ran and it seems to run fine, although the msgbox says that they are all protected (rather than unprotected).

That said, you could change it a bit so that it doesn't need to run through all the sheets, if it finds and incorrect pwd early.

Sub UnProtecAll()
Dim wSheet As Worksheet
Dim sPwd As String
    
    sPwd = InputBox("", "")
    On Error GoTo errHndl
    For Each wSheet In ThisWorkbook.Worksheets
        wSheet.Unprotect sPwd
    Next
    
    MsgBox "All sheets unprotected."
Exit Sub
errHndl:
    MsgBox """" & sPwd & """ is incorrect"
End Sub

That works well thanks.

Is there some way to limit what the password is, as the real reason for this is just so that people can't accidently break the spreadsheet. I'd like to be able to say the password is 1234, so if someone really needs to change something they can. I'd like to set the 1234 as the pass as then at least we can be sure it won't be forgotten

Thanks

 

[GTO]

That works well thanks.

Is there some way to limit what the password is, as the real reason for this is just so that people can't accidently break the spreadsheet. I'd like to be able to say the password is 1234, so if someone really needs to change something they can. I'd like to set the 1234 as the pass as then at least we can be sure it won't be forgotten

Thanks

If you are going to give the users the password, then you have no control over whether they change it.

Presuming that you have cells unlocked where data entry is to occur, why would the user need to unprotect?