Handle Cancel event on "Unprotect Sheet" password box

[rdoulaghsingh]

Ok...This one is a little tricky...at least for me it is. I have the code below which works perfectly fine until the user clicks to unlock, selects "yes" from the message box which uses Excel's "Unprotect Sheet" password prompt to request password and then clicks "Cancel". Below are the possible outcome from that password box:

1. If the user enters the password correctly it unlocks the protected sheet and hides the unlock button and shows the lock button (this works as intended).
2. If the user types in the wrong password it goes to the error handler and shows the ErrMsg msgbox (this works as intended) and
3. The user clicks cancel because they don't know the password or changes their mind from unlocking (this is where I need help)

1 and 2 work perfectly fine with the code below, but in scenario 3 the lock button shows up as if it was unlocked which it isn't and then I have to manually break the protection and lock again to get the correct flow until cancel is hit again. Any ideas?

Sub CR_Lock()
Dim msg1Counter As Integer

If ActiveSheet.ProtectContents = False Then

    msg1Counter = CreateObject("WScript.Shell").PopUp("Hang tight!" & vbCrLf & vbCrLf & "Initiating protection for " & ActiveSheet.Name & " Worksheet.", 2, "Protection in progress")

    Worksheets("Change Record").Protect Password:="Password"
    
    Worksheets("Change Record").Shapes("Lock").Visible = False
    Worksheets("Change Record").Shapes("Unlock").Visible = True

Else

    msg1Counter = CreateObject("WScript.Shell").PopUp(ActiveSheet.Name & " Worksheet is already protected.", 1, "Info.")

End If

End Sub
Sub CR_Unlock()
Dim msg2Counter As Integer

On Error GoTo ErrMsg

If ActiveSheet.ProtectContents = True Then

answer = MsgBox("Unlock " & ActiveSheet.Name & " Worksheet?", vbQuestion + vbYesNo + vbDefaultButton2, "Unlock Worksheet confirmation")

    If answer = vbYes Then
    
Application.ScreenUpdating = False

Worksheets("Change Record").Unprotect

    Worksheets("Change Record").Shapes("Lock").Visible = True
    Worksheets("Change Record").Shapes("Unlock").Visible = False

    End If

Else

msg2Counter = CreateObject("WScript.Shell").PopUp(ActiveSheet.Name & " protection is currently turned off.", 1, "Info.")
    
    End If
    
Exit Sub
    
ErrMsg:
info = MsgBox("The password you supplied is incorrect. Please verify that CAPS LOCK key is off and be sure to use the correct capitalization.", vbInformation + vbOKOnly, "Credentials failed")

Application.ScreenUpdating = True

End Sub

 

[rdoulaghsingh]

Nevermind. I fixed it.

I just had to add in another IF statement to check if the sheet was actually unlocked before switching the button visibility.

Sub CR_Lock()
Dim msg1Counter As Integer

If ActiveSheet.ProtectContents = False Then

    msg1Counter = CreateObject("WScript.Shell").PopUp("Hang tight!" & vbCrLf & vbCrLf & "Initiating protection for " & ActiveSheet.Name & " Worksheet.", 2, "Protection in progress")

    Worksheets("Change Record").Protect Password:="Password"
    
    Worksheets("Change Record").Shapes("Lock").Visible = False
    Worksheets("Change Record").Shapes("Unlock").Visible = True

Else

    msg1Counter = CreateObject("WScript.Shell").PopUp(ActiveSheet.Name & " Worksheet is already protected.", 1, "Info.")

End If

End Sub
Sub CR_Unlock()
Dim msg2Counter As Integer

On Error GoTo ErrMsg

If ActiveSheet.ProtectContents = True Then

answer = MsgBox("Unlock " & ActiveSheet.Name & " Worksheet?", vbQuestion + vbYesNo + vbDefaultButton2, "Unlock Worksheet confirmation")

    If answer = vbYes Then
    
Application.ScreenUpdating = False

Worksheets("Change Record").Unprotect

If ActiveSheet.ProtectContents = False Then

    Worksheets("Change Record").Shapes("Lock").Visible = True
    Worksheets("Change Record").Shapes("Unlock").Visible = False
    
Else

Exit Sub
        End If
    End If

Else

msg2Counter = CreateObject("WScript.Shell").PopUp(ActiveSheet.Name & " protection is currently turned off.", 1, "Info.")
    
    End If
    
Exit Sub
    
ErrMsg:
info = MsgBox("The password you supplied is incorrect. Please verify that CAPS LOCK key is off and be sure to use the correct capitalization.", vbInformation + vbOKOnly, "Credentials failed")

'MsgBox ("The password you supplied is incorrect. Please verify that CAPS LOCK key is off and be sure to use the correct capitalization."), , "MESSAGE TITLE"

Application.ScreenUpdating = True

End Sub