Incorrect Password still runs macro

[PaulWJ]

I'm trying to run a macro that unlocks certain sheets, but I want a password to do so (for security). I got a solution from the microsoft community site, but I can enter the wrong password, or just hit the cancel button and the macro still runs. Double-checked the post, but I've followed the right steps. Can anyone help please?

I've added the MS site, and confirmation I've done the first part as images. The code I've got is:

Sub UnlockSheet()

' Unlocks all the sheets and adds the tabs, column and row headers back in

Dim password As Variant
password = Application.InputBox("Enter Maintenance Password", "Password Protected")


ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = True
Sheets("Intro").Unprotect password:="relentless"
Sheets("ICC").Unprotect password:="relentless"
Sheets("GeneralQuery").Unprotect password:="relentless"
Sheets("ResCall").Unprotect password:="relentless"
Sheets("Background").Visible = xlSheetVisible
Sheets("Background").Select



End Sub

 

[RoryA]

Nothing in that code does anything at all with the password that is input. It should have something like:

Sub UnlockSheet()

' Unlocks all the sheets and adds the tabs, column and row headers back in

Dim thepassword As Variant
thepassword = Application.InputBox("Enter Maintenance Password", "Password Protected")
if thepassword <> "relentless" then 
msgbox "Incorrect password"
exit sub
end if

ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = True
Sheets("Intro").Unprotect password:=thepassword
Sheets("ICC").Unprotect password:=thepassword
Sheets("GeneralQuery").Unprotect password:=thepassword
Sheets("ResCall").Unprotect password:=thepassword
Sheets("Background").Visible = xlSheetVisible
Sheets("Background").Select



End Sub

 

[CephasOz]

You have gone to the trouble of asking for a password, but then your code ignores that and uses the real password. Below is your code, amended slightly, which should do what you want.

Sub UnlockSheet()
    ' Unlocks all the sheets and adds the tabs, column and row headers back in
    Dim strPassword As String
    '
    strPassword = Application.InputBox("Enter Maintenance Password", "Password Protected")
    If (Trim(strPassword) <> vbNullString) Then
        On Error GoTo Err_Exit
        Sheets("Intro").Unprotect strPassword
        Sheets("ICC").Unprotect strPassword
        Sheets("GeneralQuery").Unprotect strPassword
        Sheets("ResCall").Unprotect strPassword
        Sheets("Background").Visible = xlSheetVisible
        Sheets("Background").Select
        ' Put these commands here, so that they only get executed if the password is okay.
        ActiveWindow.DisplayWorkbookTabs = True
        ActiveWindow.DisplayHeadings = True
    End If
    Exit Sub
Err_Exit:
    Err.Clear
    MsgBox "Invalid password", vbCritical + vbOKOnly, "Unlock Sheet"
End Sub

 

[PaulWJ]

Nothing in that code does anything at all with the password that is input. It should have something like:

Sub UnlockSheet()

' Unlocks all the sheets and adds the tabs, column and row headers back in

Dim thepassword As Variant
thepassword = Application.InputBox("Enter Maintenance Password", "Password Protected")
if thepassword <> "relentless" then
msgbox "Incorrect password"
exit sub
end if

ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = True
Sheets("Intro").Unprotect password:=thepassword
Sheets("ICC").Unprotect password:=thepassword
Sheets("GeneralQuery").Unprotect password:=thepassword
Sheets("ResCall").Unprotect password:=thepassword
Sheets("Background").Visible = xlSheetVisible
Sheets("Background").Select



End Sub

Thanks Rory.

Think I've maybe not explained myself properly. The password the first bit of code was looking for was a 'master' password (which was different to the one in the remainder of the code).

But, the fix works, so many thanks