ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   question for Tom Ogilvi (https://www.excelbanter.com/excel-programming/345113-question-tom-ogilvi.html)

Pierre via OfficeKB.com[_2_]

question for Tom Ogilvi
 
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200511/1

Patrick Molloy[_2_]

question for Tom Ogilvi
 
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" wrote:

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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200511/1


Pierre via OfficeKB.com[_2_]

question for Tom Ogilvi
 
Thanks Patrick !!
This works fine for me !
Pierre


Patrick Molloy wrote:
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


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200511/1


All times are GMT +1. The time now is 08:19 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com