Protecting Multiple sheets with prompt for password to unprotect

[Guest]

Subject pretty much says it all, I need to be able to protect & unprotect 31 sheets in a workbook, but I also need it to ask for a password to unprotect.

 

[Rob van Gelder]

Sub drinkme()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
wks.Protect "mypassword"
Next
End Sub

Sub eatme()
Dim wks As Worksheet, strPassword As String, blnError As Boolean

strPassword = InputBox("What's the password?")
If strPassword = "" Then Exit Sub
On Error Resume Next
blnError = False
For Each wks In ThisWorkbook.Worksheets
wks.Unprotect strPassword
If Err Then
MsgBox "Password incorrect", vbExclamation
blnError = True
Exit For
End If
Next
If Not blnError Then MsgBox "Done!", vbInformation
End Sub

Rob

Subject pretty much says it all, I need to be able to protect & unprotect

31 sheets in a workbook, but I also need it to ask for a password to
unprotect.