NotInList not behaving

  • Thread starter Thread starter LSDean
  • Start date Start date
L

LSDean

I have taken the code from Dev's site and adopted it to meet my needs.
Unfortunately, the RESPONSE value doesn't seem to work as advertised.
Both RESPONSE = acDataErrContinue
and
RESPONSE = acDataErrAdded
cause the MsgBox(msg, vbYesNo + vbQuestion, "Not In List") to
reappear.

I suspect I'm missing something VERY ELEMENTARY, but I am missing it.
The table LU_SUBJECT does get updated with the new record, but
apparently the list in SubjectCode does not. The SubjectCode list is
the LU_SUBJECT table.

The look-up row source behihd SubjectCode is
SELECT LU_Subject.SubjectCode, LU_Subject.SubjectTitle FROM LU_Subject
ORDER BY LU_Subject.SubjectCode;


Private Sub SubjectCode_NotInList(NewData As String, Response As
Integer)
'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
' Private Sub cbxAEName_NotInList(NewData As String, Response As
Integer)

Dim db As DAO.database
Dim rs As DAO.Recordset
Dim msg As String
Dim sTitle As String
Dim sSQL As String
sCode = NewData
msg = "Is " & Str(NewData) & " a new Subject Code?"
If MsgBox(msg, vbYesNo + vbQuestion, "Not In List") = vbNo Then
Response = acDataErrContinue
Else
sTitle = InputBox("Enter Code Description", "Description")
Set db = CurrentDb
Set rs = db.OpenRecordset("LU_Subject", dbOpenDynaset)
On Error Resume Next
rs.AddNew
rs![SubjectCode] = NewData
rs![SubjectTitle] = sTitle
rs.Update
' Me.SubjectCode.Requery ' does not matter if active or not

If Err Then
MsgBox "An error occurred. Please try again."
Response = acDataErrContinue
Else
Response = acDataErrAdded
End If
End If

rs.Close
Set rs = Nothing
Set db = Nothing
' Exit Sub ' never reached before MsgBox() pops up
End Sub
 
Thank you ! By moving

Me.SubjectCode.Requery
to follow
rs.close

NotInList began behaving as expected. I just had not placed
me.subjectcode.requery in the correct place.


matt Weyland said:
after the event, try

Me.refresh or listbox.requery. This should solve the
problem

MW

Matt Weyland
Data Analys
Stratis Health
(e-mail address removed)
-----Original Message-----
I have taken the code from Dev's site and adopted it to meet my needs.
Unfortunately, the RESPONSE value doesn't seem to work as advertised.
Both RESPONSE = acDataErrContinue
and
RESPONSE = acDataErrAdded
cause the MsgBox(msg, vbYesNo + vbQuestion, "Not In List") to
reappear.

I suspect I'm missing something VERY ELEMENTARY, but I am missing it.
The table LU_SUBJECT does get updated with the new record, but
apparently the list in SubjectCode does not. The SubjectCode list is
the LU_SUBJECT table.

The look-up row source behihd SubjectCode is
SELECT LU_Subject.SubjectCode, LU_Subject.SubjectTitle FROM LU_Subject
ORDER BY LU_Subject.SubjectCode;


Private Sub SubjectCode_NotInList(NewData As String, Response As
Integer)
'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
' Private Sub cbxAEName_NotInList(NewData As String, Response As
Integer)

Dim db As DAO.database
Dim rs As DAO.Recordset
Dim msg As String
Dim sTitle As String
Dim sSQL As String
sCode = NewData
msg = "Is " & Str(NewData) & " a new Subject Code?"
If MsgBox(msg, vbYesNo + vbQuestion, "Not In List") = vbNo Then
Response = acDataErrContinue
Else
sTitle = InputBox("Enter Code Description", "Description")
Set db = CurrentDb
Set rs = db.OpenRecordset("LU_Subject", dbOpenDynaset)
On Error Resume Next
rs.AddNew
rs![SubjectCode] = NewData
rs![SubjectTitle] = sTitle
rs.Update
' Me.SubjectCode.Requery ' does not matter if active or not

If Err Then
MsgBox "An error occurred. Please try again."
Response = acDataErrContinue
Else
Response = acDataErrAdded
End If
End If

rs.Close
Set rs = Nothing
Set db = Nothing
' Exit Sub ' never reached before MsgBox() pops up
End Sub
.
Click to expand...
Click to expand...
 
Back
Top