VBA for sheet protect "set password required"

[Glorioso999]

Hi,

I am using the below VBA code to lock and unlock a number of sheets in my workbook using 2 separate buttons on an index page. The code works perfectly. The only issue is that I want to set the password in the code rather than have a new one entered each time i lock the sheets. (My worry is that someone other than me who is required to use this document will accidentally enter a miss spelt password and lock everyone out)

I've tried amending the code but had no joy.

Can anyone help with this -

Sub Button1_Click()
    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"
    End If
    On Error GoTo 0
End Sub

Sub Button2_Click()
 

 
 
 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
End Sub

[BillyRaySpivy]

Hello,

I use this technique in my workbooks now. My first worksheet is 'Switchboard' that I use for controls. On the worksheet I put a master password for protection in cell G9 and I set that cell to locked and also fill it with a dark color so the password cannot be viewed. Then when I click on the Protect All button the worksheets will be protected and the master password cannot be viewed by the users.

Sub ProtectAll()

  Dim wSheet As Worksheet
  Dim pwd As String
  
  'Get the 'Master Password' from the SpreadSheet (remove leading/trailing spaces)
  pwd = Trim(Sheets("Switchboard").Range("G9").Value)
  
  For Each wSheet In Worksheets
     wSheet.Protect Password:=pwd, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
     AllowFormattingColumns:=True, AllowFormattingRows:=True
  Next wSheet

End Sub

Sub UnProtectAll()
Dim wSheet As Worksheet
Dim pwd As String
pwd = InputBox("Enter your password to unprotect all worksheets")
On Error Resume Next
For Each wSheet In Worksheets
wSheet.Unprotect Password:=pwd
Next wSheet
If Err <> 0 Then
MsgBox "You have entered an incorrect password. All worksheets could not " & _
"be unprotected.", vbCritical, "Incorrect Password"
End If
On Error GoTo 0
End Sub

I hope this helps!

[kev_]

Using your code.
This gives the user 3 attempts to guess the correct password and no opportunity to change it.
Simply amend "TheCorrectPresetPassword" to whatever password you have protected the worksheets with.

Sub Button2_Click()
    Dim wSheet As Worksheet
    Dim Pwd As String
    
EnterPassword:
    If Count = 3 Then MsgBox ("Too many attempts"): Exit Sub
    Pwd = InputBox("Enter your password to protect all worksheets", "Password Input")
    Count = Count + 1
    If Pwd <> "TheCorrectPresetPassword" Then GoTo EnterPassword
    Count = 0

    For Each wSheet In Worksheets
        wSheet.Protect Password:=Pwd
    Next wSheet

End Sub

[AliGW]

Yes, thank you. Glad the issue is solved!

[Glorioso999]

Hi Ali,

Sorry about that. Hope thats sorted it