Protecting Multiple sheets with prompt for password to unprotect
 

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.

Protecting Multiple sheets with prompt for password to unprotect
 

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


"pkley" wrote in message
...
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.