Adding message and loop to input box password

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

Code:

---

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

---

Quote:

---

Code:

---

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:

Code:

---

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:

Code:

---

pword = InputBox("Please Enter Password")

---

insert at least:

Code:

---

If Len(pword) = 0 Then Exit Do

---

Artik

Thanks!