question for Tom Ogilvi

[Pierre via OfficeKB.com]

Hi Tom,
You gave me the following code to test for a name and a code before entering
the application
This works fine for me !
However, if the code is filled in wrong i would like the user to have 2 more
tries in the code field before closing down the application.
can you help me once more?
thanks,


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

 

[Patrick Molloy]

Private Sub OK_Click()
Dim nmeLst As Range, codeLst As Range
Dim resName As Variant, resCode As Variant
Static Counter As Long
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
ElseIf Counter >= 3 Then
Unload Me
ThisWorkbook.Close Savechanges:=False
Else
Counter = Counter + 1
MsgBox "Please enter code", , "Try Again"
End If
End Sub

 

[Pierre via OfficeKB.com]

Thanks Patrick !!
This works fine for me !
Pierre

Private Sub OK_Click()
Dim nmeLst As Range, codeLst As Range
Dim resName As Variant, resCode As Variant
Static Counter As Long
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
ElseIf Counter >= 3 Then
Unload Me
ThisWorkbook.Close Savechanges:=False
Else
Counter = Counter + 1
MsgBox "Please enter code", , "Try Again"
End If
End Sub

Hi Tom,
You gave me the following code to test for a name and a code before entering

[quoted text clipped - 36 lines]

End If
End Sub