Unlocking cells using VBA

[VBAmalta89]

I have a worksheet whose cells are locked. Now i want to create a button which when clicked prompts the user to input a password which if correct will unlock the cells but if the password is incorrect then it asks to renter the password.

How can i code this in VBA? (Im guessing a module needs to be created but i dont know how to code to achieve the above)

 

[JamesW]

Hi there,

A simple way of doing this would be:

Private Sub CommandButton1_Click()
    On Error Resume Next
    pass = InputBox("Please enter the password")
    ActiveSheet.Unprotect Password:=pass
    If Err.Number = 1004 Then MsgBox "Password Incorrect, please try again"
End Sub

You will assign your password in Tools -> Protection -> Protect Sheet. Using the way above users can not take a look in the VBA code and find out the password.

 

[ogo]

Hi try the below code,

Sub UnProtectSheet()
strpassword = InputBox("Please provide the password.")
For i = 1 To 3   
'Currently 3 tries are allowed
'Current password used is MyPassword
 If strpassword = "MyPassword" Then    <change to="" your="" password=""><add the="" actual="" password="" here="">

    ActiveSheet.Unprotect Password:="MyPassword"  '<<add the="" actual="" password="" here="">
    Exit For
Else: 
  If not i=3 then
    strpassword = InputBox("You entered a wrong password.Enter correct password. Tries left=" & 3 - i)
  End If
    
End If
Next
End Sub

Thanks,
Ogo</add></add></change>

 

[VBAmalta89]

thanks both worked perfectly. Just one more related question:

If i wanted to create another button to lock the sheets the code would be similar but i need to use:

ActiveSheet.Protect Password:="MyPassword"

Is this correct?

 

[ogo]

Then the code can be something like this

Sub MyProtection()
    If ActiveSheet.Name = "Sheet1" Or ActiveSheet.Name = "Sheet2" Then
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, Password:="MyPassword"
    End If
End Sub

Or Simply

Sub MyProtection()
    
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=False, Password:="MyPassword"
  
End Sub

Thanks,
Ogo

 

[VBAmalta89]

worked!

thanks!