Combine combo box and list box on Main form 1

[MADDPM]

I have a combo box on my main form that locates an employee record, then two subforms show current contract details (single form) and contract history (datasheet view). Combo box works fine. (See ComboBox Code below.)

This combo box simply goes to the record of the individual typed into the box or selected from the drop-down list – leaving all records accessible; e.g., bottom nav. bar displays Record 125 of 2987, etc.

On the main form I also have a button (just below the combo box above) which opens a listbox (see LIST BOX SPECIFICATIONS below) to more thoroughly search for an employee which is able to be sorted by different criteria; e.g., Active, Last Name, First Name, etc. This listbox also works fine. However, it does not leave all employee records accessible (like the combo box does using a record set) – it displays only the record(s) for the person selected – thereby disabling further use of the combo box – due to: "[qryMainScreenSelectRecord.EMPLOYEE_NUMBER]=" & "" & Me.lstSearch.Column(0) & "") – e.g., bottom nav. bar displays Record 1 of 1. I’ve tried creating a record set for the listbox, tried using DoCmd.GoToRecord, tried using DoCmd.FindRecord, etc. At this point, I can’t remember what I’ve tried or haven’t tried.

In any event, the short solution I’m looking for is to simply have the listbox, once it opens the Main form and finds the record the user selects, leave the remainder of the records available – so the combo box will still work. Any suggestions of where I need to add an “on close” requery, a record set setup, or any other code?

The longer solution (and preferred) would be to have one form, two boxes– the combo box would also filter the listbox (by last name only) as the user types in letters of the last name.

Any help will be greatly appreciated-
colleen

ComboBox CODE:
Event Handler After Update Code:
Private Sub Form_Current()
Me.ComboSelectEmployee.Value = Me.Employee_Number
End Sub

Private Sub ComboSelectEmployee_AfterUpdate()
On Error GoTo ErrorHandler
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[Employee_Number]= " & Str(Nz(Me![ComboSelectEmployee].Value, 0))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
CleanUpAndExit:
Exit Sub
ErrorHandler:
Call MsgBox("An error was encountered" & vbCrLf & _
vbCrLf & _
"Description: " & Err.Description & vbCrLf & _
"Error Number: " & Err.Number, , "Error")
Resume CleanUpAndExit
End Sub


LIST BOX SPECIFICATIONS:
LISTBOX Row Source:
SELECT qryMainScreenSelectRecord.EMPLOYEE_NUMBER, qryMainScreenSelectRecord.FACULTY_Active, qryMainScreenSelectRecord.Last_Name, qryMainScreenSelectRecord.First_Name, qryMainScreenSelectRecord.Preferred_Name FROM qryMainScreenSelectRecord ORDER BY qryMainScreenSelectRecord.FACULTY_Active, Last_Name;

Event Handlers AfterUpdate and OnDoubleClick

Option Compare Database
Option Explicit
Private Function basOrderby(col As String, xorder As String) As Integer
Dim strSQL As String

'Clear captions from command buttons
ClearCaptions
'Set row source for list box
strSQL = "SELECT DISTINCTROW EMPLOYEE_NUMBER, FACULTY_Active, Last_Name, First_Name, Preferred_Name "
strSQL = strSQL & "FROM qryMainScreenSelectRecord "
strSQL = strSQL & "ORDER BY " & col & " " & xorder
Me!lstSearch.RowSource = strSQL
Me!lstSearch.Requery
End Function

Private Sub ClearCaptions()
'Clear captions of asc and desc symbols
Me!cmdOrderFactiveDesc.Caption = "Order by Active Status"
Me!cmdOrderFActive.Caption = "Order by Active Status"
Me!cmdOrderLNameDesc.Caption = "Order by Last Name"
Me!cmdOrderLName.Caption = "Order by Last Name"
Me!cmdOrderFNameDesc.Caption = "Order by First Name"
Me!cmdOrderFName.Caption = "Order by First Name"
Me!cmdOrderPNameDesc.Caption = "Order by Preferred Name"
Me!cmdOrderPName.Caption = "Order by Preferred Name"
End Sub

Private Sub cmdOrderFActive_Click()
'Set Active Status order in ascending order and apply captions
Dim response As Integer
response = basOrderby("FACULTY_Active", "asc")
Me!cmdOrderFactiveDesc.Visible = True
Me!cmdOrderFactiveDesc.Caption = "v Active Status v"
Me!cmdOrderFactiveDesc.SetFocus
Me!cmdOrderFActive.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderFActiveDesc_Click()
'Set Active Status order in descending order and apply captions
Dim response As Integer
response = basOrderby("FACULTY_Active", "DESC")
Me!cmdOrderFActive.Visible = True
Me!cmdOrderFActive.Caption = "^ Active Status ^"
Me!cmdOrderFActive.SetFocus
Me!cmdOrderFactiveDesc.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderLName_Click()
'Set Last Name order in ascending order and apply captions
Dim response As Integer
response = basOrderby("Last_Name", "asc")
Me!cmdOrderLNameDesc.Visible = True
Me!cmdOrderLNameDesc.Caption = "v Last Name v"
Me!cmdOrderLNameDesc.SetFocus
Me!cmdOrderLName.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderLNameDesc_Click()
'Set Last Name order in descending order and apply captions
Dim response As Integer
response = basOrderby("Last_Name", "DESC")
Me!cmdOrderLName.Visible = True
Me!cmdOrderLName.Caption = "^ Last Name ^"
Me!cmdOrderLName.SetFocus
Me!cmdOrderLNameDesc.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderFName_Click()
'Set First Name order in ascending order and apply captions
Dim response As Integer
response = basOrderby("First_Name", "asc")
Me!cmdOrderFNameDesc.Visible = True
Me!cmdOrderFNameDesc.Caption = "v First Name v"
Me!cmdOrderFNameDesc.SetFocus
Me!cmdOrderFName.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderFNameDesc_Click()
'Set First Name order in descending order and apply captions
Dim response As Integer
response = basOrderby("First_Name", "DESC")
Me!cmdOrderFName.Visible = True
Me!cmdOrderFName.Caption = "^ First Name ^"
Me!cmdOrderFName.SetFocus
Me!cmdOrderFNameDesc.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderPName_Click()
'Set Preferred Name order in ascending order and apply captions
Dim response As Integer
response = basOrderby("Preferred_Name", "asc")
Me!cmdOrderPNameDesc.Visible = True
Me!cmdOrderPNameDesc.Caption = "v Preferred Name v"
Me!cmdOrderPNameDesc.SetFocus
Me!cmdOrderPName.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub cmdOrderPNameDesc_Click()
'Set Preferred Name order in descending order and apply captions
Dim response As Integer
response = basOrderby("Preferred_Name", "DESC")
Me!cmdOrderPName.Visible = True
Me!cmdOrderPName.Caption = "^ Preferred Name ^"
Me!cmdOrderPName.SetFocus
Me!cmdOrderPNameDesc.Visible = False
Me!lstSearch.SetFocus
End Sub

Private Sub lstSearch_AfterUpdate()
'Once a record is selected in the list, enable the showRecord button
ShowRecord.Enabled = True
End Sub

Private Sub lstSearch_DblClick(Cancel As Integer)
'If the user double-clicks in the list, act as though
'the ShowRecord button was clicked
If Not IsNull(lstSearch) Then
ShowRecord_Click
End If
End Sub

Private Sub ShowRecord_Click()
'Find a selected record, then close the search dialog box
DoCmd.OpenForm "frmMainFacultyData", , , _
"[qryMainScreenSelectRecord.EMPLOYEE_NUMBER]=" & "" & Me.lstSearch.Column(0) & ""
'Close the dialog box
DoCmd.Close acForm, "frmListBoxSearch"
End Sub

Private Sub Cancel_Click()
On Error GoTo Err_Cancel_Click
'Cancel and close the form
DoCmd.Close
Exit_Cancel_Click:
Exit Sub
Err_Cancel_Click:
MsgBox Err.Description
Resume Exit_Cancel_Click
End Sub

 

[MajP]

Can you explain the preferred solution better? What functions would you like to have?

If I understood correctly you want a Find as you type combobox (by last name) that filters the listbox as you type in the combobox or select from the combobox. Not sure why you would even need the combobox. Why not a listbox with a text box over top of it? Then as you type in the text box it filters the list box. Then you select from the listbox to go to the record.

 

[MADDPM]

Hi MajP,
"Why not a listbox with a text box over top of it?" would be perfect! ... but I haven't been successful at combining the two ideas on one form.
thanks-
colleen

 

[MajP]

http://www.4shared.com/file/151404420/cc5ae9c/DemoFAYTlistBox.html

take a look at these demos. You will not have to write more than a couple of lines of code, because it uses a class module to encapsulate all the functionality.

This version is a little strange, but someone asked if I could demo it. Not only is it a find as you type listbox, but as you type if navigates the form to the first record in the filtered list. So it is a combined find as you type listbox and find as you type form.

http://www.4shared.com/file/151793571/1124281e/DemoFAYTlistBox_and_Search.html

What I probably need to add to these is the ability to go to the selected record. However, you can just code that in the form. This should work with all your existing code.

 

[MajP]

For the second example there is a method in the class module:

Public Sub moveForm()
'Special procedure to find your record.
'modifiy as appropriate
mForm.Recordset.FindFirst "supplierID = " & mListbox
End Sub

You will need to change the line
mForm.Recordset.FindFirst "supplierID = " & mListbox
to do the correct search.

Also substitute this:

Private Sub mListBox_AfterUpdate()
moveForm
Call unFilterList
mTextBox.SetFocus
mTextBox.Value = Null
End Sub

Now you can filter as you type, go immediately to the first record in the filtered list, and then click on another item in the list and go to that item.

 

[MADDPM]

Hi MajP,
This is perfect, except I'm having a bit of trouble getting the procedure go to the record (I'm messing up or omitting code somewhere).

FORM CODE:
Option Compare Database
Option Explicit

Public faytListEmployees As FindAsYouTypeListBox

Private Sub Form_Load()
'This is all that is needed for the FAYT class method
Set faytListEmployees = New FindAsYouTypeListBox
faytListEmployees.Initialize Me.lstEmployees, Me.txtBxFilter, "Full_Name"
End Sub

Private Sub lstEmployees_AfterUpdate()
End Sub

Private Sub txtBxFilter_GotFocus()
End Sub

Private Sub cmdCloseForm_Click()
On Error GoTo Err_cmdCloseForm_Click
If Me.Dirty Then Me.Dirty = False
DoCmd.Close
Exit_cmdCloseForm_Click:
Exit Sub
Err_cmdCloseForm_Click:
MsgBox Err.Description
Resume Exit_cmdCloseForm_Click
End Sub

CLASS MODULE CODE:
Option Compare Database
Option Explicit

'Class Module Name: FindAsYouTypeListBox
'Purpose: Turn any Listbox into a "Find As You Type" listbox
'Created by: MajP - Tek-Tips -

http://www.4shared.com/file/151793571/1124281e/DemoFAYTlistBox_and_Search.html

'Demonstrates: OOP, and With Events
'
'Use:To use the class, you need code similar to the 'following in a form's module.
'Also requires a reference to DAO
'Two properties must be set: FilterListBox
'and FilterFieldName. These are the combo box object
'and the name of the field that you are filtering.
'

Private WithEvents mListbox As Access.ListBox
Private WithEvents mForm As Access.Form
Private WithEvents mTextBox As Access.TextBox
Private mFilterFieldName As String
Private mRsOriginalList As DAO.Recordset
Public Property Get FilterListBox() As Access.ListBox
Set txtBxFilter = mListbox
End Property
Private Sub mTextBox_Change()
Call FilterList
End Sub
Private Sub mListBox_AfterUpdate()
moveForm
Call unFilterList
mTextBox.SetFocus
mTextBox.Value = Null
End Sub
Private Sub mForm_Current()
Call unFilterList
End Sub
Private Sub FilterList()
On Error GoTo errLable
Dim rsTemp As DAO.Recordset
Dim strText As String
Dim strFilter As String
strText = mTextBox.Text
If mFilterFieldName = "" Then
MsgBox "Must Supply A FieldName Property to filter list."
Exit Sub
End If
strFilter = mFilterFieldName & " like '" & strText & "*'"
Set rsTemp = mRsOriginalList.OpenRecordset
rsTemp.Filter = strFilter
Set rsTemp = rsTemp.OpenRecordset
If rsTemp.RecordCount > 0 Then
Set mListbox.Recordset = rsTemp
'modified code to select first item
mListbox.Selected(0) = True
'Modified to set the value of the listbox
mListbox.Value = mListbox.Column(0)
Call moveForm
End If
mTextBox.SelStart = Len(mTextBox.Text)
Exit Sub
errLable:
If Err.Number = 3061 Then
MsgBox "Will not Filter. Verify Field Name is Correct."
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Private Sub unFilterList()
On Error GoTo errLable
Set mListbox.Recordset = mRsOriginalList
Exit Sub
errLable:
If Err.Number = 3061 Then
MsgBox "Will not Filter. Verify Field Name is Correct."
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub
Public Property Get FilterFieldName() As String
Last_Name = mFilterFieldName
End Property
Public Property Let FilterFieldName(ByVal theFieldName As String)
mFilterFieldName = theFieldName
End Property
Private Sub Class_Terminate()
Set mForm = Nothing
Set mListbox = Nothing
Set mRsOriginalList = Nothing
End Sub

Public Sub Initialize(theListBox As Access.ListBox, theTextBox As Access.TextBox, FieldName As String)
On Error GoTo errLabel
If Not theListBox.RowSourceType = "Table/Query" Then
MsgBox "This class will only work with a ListBox that uses a Table or Query as the Rowsource"
Exit Sub
End If
Me.FilterFieldName = FieldName
Set mListbox = theListBox
Set mForm = theListBox.Parent
Set mTextBox = theTextBox
mForm.OnCurrent = "[Event Procedure]"
mTextBox.OnGotFocus = "[Event Procedure]"
mTextBox.OnChange = "[Event Procedure]"
mListbox.AfterUpdate = "[Event Procedure]"

Set mRsOriginalList = mListbox.Recordset.Clone
Exit Sub
errLabel:
MsgBox Err.Number & " " & Err.Description
End Sub
Public Sub moveForm()
'Special procedure to find your record - modifiy as appropriate.
mForm.Recordset.FindFirst "EMPLOYEE_NUMBER = " & mListbox
End Sub

I just can't figure out what I'm doing wrong. Any ideas?

Many thanks-
colleen

 

[MajP]

Assuming all else is working the only code that moves to the reocord is here

Public Sub moveForm()
'Special procedure to find your record - modifiy as appropriate.
mForm.Recordset.FindFirst "EMPLOYEE_NUMBER = " & mListbox
End Sub

is the bound column in the listbox your employee number?
the bound column is the value returned in a multi column listbox
is the employee number a numeric or string?

In order for this to work the bound column needs to be the employee number column
if employee number is a string
mForm.Recordset.FindFirst "EMPLOYEE_NUMBER = '" & mlistbox & "'"

 

[MajP]

unless specified the bound column is the first column

 

[MADDPM]

Yes, EMPLOYEE_NUMBER is the bound column in the listbox - and it's numeric.

I have some uninterrupted time today - so perhaps I'll figure it out. Would it matter if the field "Full_Name" is a concatenated field?
faytListEmployees.Initialize Me.lstEmployees, Me.txtBxFilter, "Full_Name"

Thanks-
colleen

 

[MajP]

Does it filter correctly?
If it does filter then the only issue is in the move method.
Do you get an error?
If so what is the error?

If no error change the move method to this and report what happens

Public Sub moveForm()
msgbox "Move. " & "EMPLOYEE_NUMBER = " & mListbox
mForm.Recordset.FindFirst "EMPLOYEE_NUMBER = " & mListbox
End Sub


faytListEmployees.Initialize Me.lstEmployees, Me.txtBxFilter, "Full_Name"

Full_Name used above specifies the field that you want to filter.

 

[MADDPM]

Hi MajP,

Okay, I replaced the code you suggested above: Message received was "Move.EMPLOYEE_NUMBER=3143389"

Which helped me to realize, yes, the list box is indeed finding the correct record on the "look-up form" itself. So, yes, it is working.

However, with a clear head today, I realized I'm waiting for it to go to the record on my main form "frmMainFacultyData"


So near the end I changed:
Set mForm = frmMainFacultyData

But that didn't work so I added near the top of the code:

Public Property Get frmMainFacultyData() As Access.Form
Set frmMainFacultyData = mForm
End Property

I'm still receiving the error message "91 Object variable or With block variable not set."

Before I mess up anything else, can you tell me how/where to define the form?

Many thanks-
colleen

 

[MajP]

You do not need to mess with the code within the class.
Within the initialize event there is code that does this
Set mForm = theListBox.Parent
so it automatically sets mform to the form where the listbox is.

Lets just take the movement out of the class module and put it on your form's module.

Do this. Restore the class module back to its original state. Then code out the move event so there is no code in it.

Public Sub moveForm()

end Sub

Now on your form, where the listbox resides, capture the listbox after update event

Private Sub lstEmployees_AfterUpdate()
dim strFind as string
strFind = "EMPLOYEE_NUMBER = " & me.lstEmployees
debug.print strFind
forms("frmMainFacultyData").recordset.findFirst strFind
End Sub

See if that works. If not, can you post the db. Put fake info into the proprietary data and provide a handful of records.

 

[MADDPM]

Hi MajP,

A sample db is posted. When you open it, it will open to a dashboard - click on the button in the lower right-hand corner labeled "EMPLOYEE RECORDS (Data Entry)". That will open the main data entry form I'd like to search from. On that form, in the upper left-hand corner, you will find a combo box (which currently works, but is limited) and a button labeled "Search Employees" - which goes to the form in question which I'm working on.

BTW - I use Access 2007.

Many thanks for all of your time on this!
colleen

 

[MajP]

Homer Simpson would say "Doh."
You lstbox was called lstSearch. You had the code here

Private Sub lstEmployees_AfterUpdate()
Dim strFind As String
strFind = "EMPLOYEE_NUMBER = " & Me.lstEmployees
Debug.Print strFind
Forms("frmMainFacultyData").Recordset.FindFirst strFind
End Sub


It should be here.

Private Sub lstSearch_AfterUpdate()
'Once a record is selected in the list, enable the showRecord button

Dim strFind As String
strFind = "EMPLOYEE_NUMBER = " & Me.lstEmployees
Debug.Print strFind
Forms("frmMainFacultyData").Recordset.FindFirst strFind
ShowRecord.Enabled = True
End Sub

works for me

 

[MADDPM]

Hi MajP,

Ahhh, finally. A few more tweaks specific to the form and it is now correctly working!

Many thanks for recognizing my mix-up of the two list boxes - that's what happens when I stare at code too long, I simply overlook the obvious or simple stuff.

thanks again!
colleen

 

[MajP]

One thing you may want to do is change the filter to this:
strFilter = mFilterFieldName & " like '*" & strText & "*'"
from
strFilter = mFilterFieldName & " like '" & strText & "*'"


That way if they know the first name they can type in
Jo
and it will return both first names with Jo and last names with jo in them.

Not sure if you even need the employee listbox you could have done this directly on the lstSearch. So then you could filter and sort. All in one area

The only thing you would have to do is change your sort to

Private Function basOrderby(col As String, xorder As String)   
  As Integer
  Dim strSQL As String
  Dim rs As DAO.Recordset
  Set rs = lstSearch.Recordset
  'Clear captions from command buttons
  ClearCaptions
  rs.Sort = col & " " & xorder
  Set lstSearch.Recordset = rs.OpenRecordset
End Function

 

[MADDPM]

OMG - this was my problem after my last post - and you solved it for me without me having to re-post!

Thank you so, so much! Everything is perfect.

Enjoy your holidays!
colleen

 

[MADDPM]

One more tiny problem - when searching for a name with an apostrophe in it - I get an error message:
3075 Syntax error in string in query expression 'Full_Name like'o'*';'.

So, I believe I will need to do something to this line in the Class Module:
strFilter = mFilterFieldName & " like '" & strText & "*'"

Got any ideas?

Many thanks-
colleen

 

[MajP]

prior to the filter add:
strText = Replace(strText, "'", "''")

 

[MADDPM]

PERFECT!

Thanks again-
coleen