Adding message and loop to input box password

[freetimefost]

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]

ElseIf pword <> ThisWorkbook.Sheets("Passwords").Range("B:B").Value Then

This 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]

Thanks!