Password protecting UserForm?

[LiamPotter]

Private Sub cmbValidate_Click()
Dim FindR As Range
Dim FindR2 As Range
On Error Resume Next
Set FindR = Sheet9.Range("D").Find(What:=UserForm2.tbxUser.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
Set FindR2 = Sheet9.Range("E").Find(What:=UserForm2.tbxPW.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
On Error GoTo 0
Dim sMsg As String, sTitle As String, sStyle As String
Dim iCounta As Integer
iCounta = Me.tbxGoes.Value
sTitle = "Hub Access Manager - Invalid"
sMsg = "You have entered an incorrect Username and/or Password" & vbNewLine & "Please try again using your exact details." & vbNewLine & "You have " & (3 - iCounta) & " attempts remaining."
sStyle = vbOKOnly + vbExclamation
If iCounta < 3 Then
If Me.tbxUser.Value <> FindR Or Me.tbxPW.Value <> FindR2 Then
MsgBox sMsg, sStyle, sTitle
With Me
tbxUser.Value = vbNullString
tbxPW = vbNullString
tbxUser.SetFocus
tbxGoes.Value = iCounta + 1
End With
Else
Sheet9.Range("B1").Value = UserForm2.tbxUser.Value
Unload Me
UserForm1.Show
UserForm1.Label226 = Sheet9.Range("B1").Value
End If
ElseIf iCounta > 2 Then
MsgBox "You have tried three time incorrectly. Hub Access Manager will now close the Hub.", vbOKOnly + vbExclamation, "Hub Access Manager: Closing"
ActiveWorkbook.Close SaveChanges:=False
End If
End Sub

I am using the above code to password-protect UserForm1 by using UserForm2. Although I know these password protect systems are easily surpassed I need some level of protection in the UserForm as it contains confidential information and it's been requested from a higher level.

I have highlighted in red where I am encountering the dreaded [91] error "Object variable or With block variable no set".

Simply put, I have a small range of Usernames and Passwords in range D:E (D being Usernames, E being passwords). I want the password checker to search through the Usernames and passwords and if the relevant Username and Password entered by the user isn't found then I want them to be notified and they have 2 further attempts. After the third attempt the program will simply exit. If they enter a correct Username and Password combination, then they are directed to UserForm1.

The code above worked like a dream for the counter (which advises the user which try they are on) and for putting a "Logged in as: XXX" message on UserForm1 once successfully entered however only for a singular set Username/Password. Short of giving every one of the expected 300 or so users of this program a copy of their own and changing every bit of code for each user, is there anyway I can edit the above code to make it work?

Many thanks in advance for any help.

For your ease of helping, please find a copy of the workbook via the link below - please ignore all the random details in each of the sheets, only the UserForm is important

http://www.nippyzip.com/uploads/080519105604-01993.zip

~Liam

[royUK]

Are those TextBoxes in the UserForm containing the code?

[LiamPotter]

Yes they are, please find at the bottom of my post a copy of the program so you can work through yourself. I recommend you put macro's on very high so you can have a look at the code etc.

~Liam

[royUK]

It doesn't appear to be finding the user name.

Where did you get this code from?

[LiamPotter]

http://www.ozgrid.com/forum/showthre...light=password

The code in my original post is my edited version to *attempt* to make it work with my UserForm. Do you have any suggestions on what I can do to make it work with my UserForm?

The code in the link above is for a singular Username and password whereas I want the code to look through the Usernames in my range and the corresponding passwords in the cell to the right (FindR.Offset(0,1)?) from what the user has entered into UserForm2.

Thank you for taking your time to help me, very much appreciated!

~Liam

[Leith Ross]

Hello Liam,

Here is the updated routine. The Find function of a Range objects returns Nothing if the value isn't found in the specified range. A Null String or empty quotes can not be logically compared with a the Nothing object type.

Private Sub cmbValidate_Click()

  Dim FindR As Range
  Dim FindR2 As Range
  Dim iCounta As Integer
  Dim sMsg As String, sTitle As String
  Dim sStyle As Long
  
    Set FindR = Sheet9.Range("D").Find(What:=UserForm2.tbxUser.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    Set FindR2 = Sheet9.Range("E").Find(What:=UserForm2.tbxPW.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    
      If FindR Is Nothing Or FindR2 Is Nothing Then GoTo InvalidEntry
    
      If iCounta < 3 Then
        If Me.tbxUser.Value <> FindR Or Me.tbxPW.Value <> FindR2 Then
          GoTo InvalidEntry
        Else
          Sheet9.Range("B1").Value = UserForm2.tbxUser.Value
          Unload Me
          UserForm1.Show
          UserForm1.Label226 = Sheet9.Range("B1").Value
        End If
      ElseIf iCounta > 2 Then
        MsgBox "You have tried three time incorrectly. Hub Access Manager will now close the Hub.", _
                vbOKOnly + vbExclamation, "Hub Access Manager: Closing"
        ActiveWorkbook.Close SaveChanges:=False
      End If
      
  Exit Sub
  
InvalidEntry:

    iCounta = Me.tbxGoes.Value
    sTitle = "Hub Access Manager - Invalid"
    sMsg = "You have entered an incorrect Username and/or Password" _
         & vbNewLine & "Please try again using your exact details." _
         & vbNewLine & "You have " & (3 - iCounta) & " attempts remaining."
    sStyle = vbOKOnly + vbExclamation

      MsgBox sMsg, sStyle, sTitle
        With Me
          tbxUser.Value = vbNullString
          tbxPW = vbNullString
          tbxUser.SetFocus
          tbxGoes.Value = iCounta + 1
        End With

End Sub

Sincerely,
Leith Ross

[royUK]

Try this

Private Sub cmbValidate_Click()
    Dim FindR  As Range
    Dim FindR2 As Range
    Dim sMsg As String, sTitle As String, sStyle As String
    Dim iCounta As Integer

    On Error Resume Next
    Set FindR = Sheet9.Range("D1:D10").Find(What:=Me.tbxUser.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If FindR Is Nothing Then MsgBox Me.tbxUser & " is not listed", vbCritical, "Incorrect user name"
    Exit Sub
    Set FindR2 = Sheet9.Range("E1:E10").Find(What:=Me.tbxPW.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If FindR2 Is Nothing Then MsgBox Me.tbxPW & " is not listed", vbCritical, "Incorrect password"
    Exit Sub
    On Error GoTo 0

    iCounta = Me.tbxGoes.Value
    sTitle = "Hub Access Manager - Invalid"
    sMsg = "You have entered an incorrect Username and/or Password" & vbNewLine & "Please try again using your exact details." & vbNewLine & "You have " & (3 - iCounta) & " attempts remaining."
    sStyle = vbOKOnly + vbExclamation
    If iCounta < 3 Then
        If Me.tbxUser.Value <> FindR Or Me.tbxPW.Value <> FindR2 Then
            MsgBox sMsg, sStyle, sTitle
            With Me
                tbxUser.Value = vbNullString
                tbxPW = vbNullString
                tbxUser.SetFocus
                tbxGoes.Value = iCounta + 1
            End With
        Else
            UserForm1.Label226 = Me.tbxUser.Value
            '            Sheet9.Range("B1").Value = Me.tbxUser.Value
            UserForm1.Show
            Unload Me
            '            UserForm1.Label226 = Sheet9.Range("B1").Value
        End If
    ElseIf iCounta > 2 Then
        MsgBox "You have tried three time incorrectly. Hub Access Manager will now close the Hub.", vbOKOnly + vbExclamation, "Hub Access Manager: Closing"
        ActiveWorkbook.Close SaveChanges:=False
    End If
End Sub