Put this in the form(has 2 text boxes 3 buttons)
Dim PWDloop As Integer
Dim User As String
Dim UserRow As Integer
Dim UsrLevel As Integer
Dim Pwd As String
Dim TmpPwd As String
Dim PWDLastRow As Integer
Sub SearchUser()
User = "NULL"
PWDLastRow = Range(Worksheets("PWDDATA").UsedRange.Address).Rows.Count
For PWDloop = 1 To PWDLastRow
If UCase(UserForm1.TextBox1.Text) = Worksheets("PWDDATA").Range("A" & PWDloop).Value Then
User = UCase(UserForm1.TextBox1.Text)
UserRow = PWDloop
Exit For
End If
Next PWDloop
If User <> "NULL" Then
ReadPWD
Else
MsgBox "User Not Found.", vbCritical, ThisWorkbook.Name
End If
End Sub
Sub ReadPWD()
Pwd = Worksheets("PWDDATA").Range("B" & UserRow).Value
PWDDecipher
If UserForm1.TextBox2.Text = Pwd Then
UsrLevel = Worksheets("PWDDATA").Range("C" & UserRow).Value
MsgBox "Password accepted User Level is " & UsrLevel
Else
MsgBox "Password Incorrect"
End If
End Sub
Sub PWDDecipher()
TmpPwd = ""
For PWDloop = 1 To Len(Pwd)
TmpPwd = TmpPwd & Chr(Asc(Mid(Pwd, PWDloop, 1)) + (1 * PWDloop))
Next PWDloop
Pwd = TmpPwd
TmpPwd = ""
For PWDloop = Len(Pwd) To 1 Step -1
TmpPwd = TmpPwd & Mid(Pwd, PWDloop, 1)
Next PWDloop
Pwd = TmpPwd
End Sub
Sub PWDCipher()
TmpPwd = ""
For PWDloop = Len(Pwd) To 1 Step -1
TmpPwd = TmpPwd & Mid(Pwd, PWDloop, 1)
Next PWDloop
Pwd = TmpPwd
TmpPwd = ""
For PWDloop = 1 To Len(Pwd)
TmpPwd = TmpPwd & Chr(Asc(Mid(Pwd, PWDloop, 1)) - (1 * PWDloop))
Next PWDloop
Pwd = TmpPwd
End Sub
Private Sub CommandButton1_Click() 'OK
SearchUser
End Sub
Private Sub CommandButton2_Click() 'CHANGE
'change user data
End Sub
Private Sub CommandButton3_Click() 'EXIT
Unload UserForm1
End Sub