PDA

View Full Version : Adding message and loop to input box password



freetimefost
01-22-2020, 12:53 PM
I'm trying to add a message box if an invalid password has been entered into the below, but keep getting a runtime error, any ideas on how to fix this?

Runtime Error 13
Type Mismatch

Thanks




Private Sub Workbook_Open()
Do
pword = InputBox("Please Enter Password")
If pword = ThisWorkbook.Sheets("Passwords").Range("B4").Value Then
Statement = True
Sheet3.Visible = True
Sheet3.Unprotect ("blue")
Sheet3.Select


ElseIf pword = ThisWorkbook.Sheets("Passwords").Range("B5").Value Then
Statement = True
Sheet4.Visible = True
Sheet4.Unprotect ("yellow")
Sheet4.Select

ElseIf pword = ThisWorkbook.Sheets("Passwords").Range("B6").Value Then
Statement = True
Sheet5.Visible = True
Sheet5.Unprotect ("red")
Sheet5.Select

ElseIf pword = ThisWorkbook.Sheets("Passwords").Range("B3").Value Then
Statement = True
Sheet3.Visible = True
Sheet3.Unprotect ("blue")
Sheet4.Visible = True
Sheet4.Unprotect ("yellow")
Sheet5.Visible = True
Sheet5.Unprotect ("red")
Sheet1.Visible = True
Sheet1.Unprotect ("admin")
Sheet1.Select
ElseIf pword <> ThisWorkbook.Sheets("Passwords").Range("B:B").Value Then
MsgBox "Incorrect Password Entered. Please Try Again"
End If
Loop Until Statement = True
End Sub

Artik
01-22-2020, 05:21 PM
ElseIf pword <> ThisWorkbook.Sheets("Passwords").Range("B:B").Value ThenThis line of code is not allowed due to an incorrect attempt to compare values to a multicell range. Instead of this unhealthy condition, simply insert:
Else

Another problem with the code. You do not allow the user to opt out of entering the password. Many after ten attempts would like to give up, and you do not allow him to do so. After the following line:

pword = InputBox("Please Enter Password")insert at least:
If Len(pword) = 0 Then Exit Do

Artik

freetimefost
01-22-2020, 05:31 PM
Thanks!