Handle Cancel event on "Unprotect Sheet" password box

rdoulaghsingh

Board Regular
Joined
Feb 14, 2021
Messages
76
Office Version
  1. 365
Platform
  1. Windows
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?

VBA Code:
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
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

rdoulaghsingh

Board Regular
Joined
Feb 14, 2021
Messages
76
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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
 
Solution

Forum statistics

Threads
1,141,581
Messages
5,707,202
Members
421,498
Latest member
matinebi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top