check if in list else quit application

[Pierre via OfficeKB.com]

Hi,

i have a userform where the user has to put in
- a name in textbox called txt_naam
- a code in a txtbox (txt_code)

futhermore there is a button "OK"

If the button OK is clicked i want to
- check if the boxes are filled. if one of them is not filled, i need to set
the focus back on the first empty box

if the boxes are filled, the code has to be checked in a list Sheets("check")
in range H1:H1000

If the code that is put in the textbox i want to check if the code is in the
list.
- if it is not, i want to quit the application
- if it is, my application can start and i would like cell a1 to be filled
with the txtboxvalue that the user has put in.

Last but not least.
Next time the application is started it should see that there is a code in
cell A1 and skip the login screen completely...

I know it is a lot to ask but i tried and tried and only got error messages...

Please help me get the right code
Pierre

 

[Tom Ogilvy]

Private Sub OK_Click()
Dim nmeLst As Range, codeLst As Range
Dim resName As Variant, resCode As Variant
If txt_naam = "" And txt_code = "" Then
MsgBox "Please enter name and code"
txt_naam.SetFocus
Exit Sub
End If
If txt_naam = "" Then
MsgBox "Please enter name"
txt_naam.SetFocus
Exit Sub
End If
If txt_code = "" Then
MsgBox "Please enter code"
txt_code.SetFocus
Exit Sub
End If
With Worksheets("Check")
Set codeLst = .Range(.Cells(1, "H"), .Cells(1, "H").End(xlDown))
' Set nameLst = .Range(.Cells(1, "G"), .Cells(1, "G").End(xlDown))
End With
'resName = Application.Match(txt_naam, nmeLst, 0)
resCode = Application.Match(txt_code, codeLst, 0)
If Not IsError(resCode) Then
ActiveSheet.Range("A1").Value = txt_naam
Else
Unload Me
ThisWorkbook.Close Savechanges:=False
End If
End Sub

Private Sub UserForm_Activate()
If Not IsEmpty(ActiveSheet.Range("A1")) Then
Unload Me
End If
End Sub

 

[Pierre via OfficeKB.com]

Thanks Tom, this works very nicely !!
Pierre

Private Sub OK_Click()
Dim nmeLst As Range, codeLst As Range
Dim resName As Variant, resCode As Variant
If txt_naam = "" And txt_code = "" Then
MsgBox "Please enter name and code"
txt_naam.SetFocus
Exit Sub
End If
If txt_naam = "" Then
MsgBox "Please enter name"
txt_naam.SetFocus
Exit Sub
End If
If txt_code = "" Then
MsgBox "Please enter code"
txt_code.SetFocus
Exit Sub
End If
With Worksheets("Check")
Set codeLst = .Range(.Cells(1, "H"), .Cells(1, "H").End(xlDown))
' Set nameLst = .Range(.Cells(1, "G"), .Cells(1, "G").End(xlDown))
End With
'resName = Application.Match(txt_naam, nmeLst, 0)
resCode = Application.Match(txt_code, codeLst, 0)
If Not IsError(resCode) Then
ActiveSheet.Range("A1").Value = txt_naam
Else
Unload Me
ThisWorkbook.Close Savechanges:=False
End If
End Sub

Private Sub UserForm_Activate()
If Not IsEmpty(ActiveSheet.Range("A1")) Then
Unload Me
End If
End Sub

Hi,

[quoted text clipped - 25 lines]

Please help me get the right code
Pierre

 

[Pierre via OfficeKB.com]

Dear tom,

excellent code you gave me.
However i have one morequestion.

The code now closes the appl. immediately.
I woul like to give the user 3 tries and then close the appl.

can you help me once again please?
Thanks,
Pierre

Private Sub OK_Click()
Dim nmeLst As Range, codeLst As Range
Dim resName As Variant, resCode As Variant
If txt_naam = "" And txt_code = "" Then
MsgBox "Please enter name and code"
txt_naam.SetFocus
Exit Sub
End If
If txt_naam = "" Then
MsgBox "Please enter name"
txt_naam.SetFocus
Exit Sub
End If
If txt_code = "" Then
MsgBox "Please enter code"
txt_code.SetFocus
Exit Sub
End If
With Worksheets("Check")
Set codeLst = .Range(.Cells(1, "H"), .Cells(1, "H").End(xlDown))
' Set nameLst = .Range(.Cells(1, "G"), .Cells(1, "G").End(xlDown))
End With
'resName = Application.Match(txt_naam, nmeLst, 0)
resCode = Application.Match(txt_code, codeLst, 0)
If Not IsError(resCode) Then
ActiveSheet.Range("A1").Value = txt_naam
Else
Unload Me
ThisWorkbook.Close Savechanges:=False
End If
End Sub

Private Sub UserForm_Activate()
If Not IsEmpty(ActiveSheet.Range("A1")) Then
Unload Me
End If
End Sub

Hi,

[quoted text clipped - 25 lines]

Please help me get the right code
Pierre