Large Combo Box

[Guest]

I have a combo box that contains ~ 9000 records. By default the combo box
doesn't load the entire record set when activated, and when I use the scroll
bar to try and select a record near the end it takes a dozen loads before I
finally reach the end. How can I get the combo box to either load all the
records, or do a type ahead to dynamically filter the results?

Thanks,
Ken

 

[Fred Boer]

Dear KPR:

I use the following function:

Public Function fncLoadcbo(frm As Access.Form)

Dim ctl As Access.Control
Dim lngDummy As Long

On Error GoTo ErrorHandler

' Cycle through the form's controls,
' testing for combo boxes,
' and pre-load each combobox.
For Each ctl In frm.Controls
If TypeOf ctl Is ComboBox Then
'Force combobox to load all records
lngDummy = ctl.ListCount
End If
Next

ExitPoint:
Exit Function

ErrorHandler:
fncErrorMessage Err.Number, Err.Description
Resume ExitPoint

End Function

I use this in the form's Open event:

Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrorHandler

Call fncLoadcbo([Form])

Me.cboSubject.SetFocus

ExitPoint:
Exit Sub
ErrorHandler:
fncErrorMessage Err.Number, Err.Description
Resume ExitPoint

End Sub


HTH
Fred Boer

P.S. I *know* I didn't write this myself. (I *do* try to keep track of code
written for me by real experts; however, I don't recall for certain who
wrote this.) So my apologies for not crediting the true author!

 

[Fred Boer]

P.P.S.

Oops... I meant to remove the error handling code (which contains a
reference to a custom function...

Fred

Dear KPR:

I use the following function:

Public Function fncLoadcbo(frm As Access.Form)

Dim ctl As Access.Control
Dim lngDummy As Long

On Error GoTo ErrorHandler

' Cycle through the form's controls,
' testing for combo boxes,
' and pre-load each combobox.
For Each ctl In frm.Controls
If TypeOf ctl Is ComboBox Then
'Force combobox to load all records
lngDummy = ctl.ListCount
End If
Next

ExitPoint:
Exit Function

ErrorHandler:
fncErrorMessage Err.Number, Err.Description
Resume ExitPoint

End Function

I use this in the form's Open event:

Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrorHandler

Call fncLoadcbo([Form])

Me.cboSubject.SetFocus

ExitPoint:
Exit Sub
ErrorHandler:
fncErrorMessage Err.Number, Err.Description
Resume ExitPoint

End Sub


HTH
Fred Boer

P.S. I *know* I didn't write this myself. (I *do* try to keep track of
code written for me by real experts; however, I don't recall for certain
who wrote this.) So my apologies for not crediting the true author!

I have a combo box that contains ~ 9000 records. By default the combo box
doesn't load the entire record set when activated, and when I use the
scroll
bar to try and select a record near the end it takes a dozen loads before
I
finally reach the end. How can I get the combo box to either load all the
records, or do a type ahead to dynamically filter the results?

Thanks,
Ken

 

[Peter Hibbs]

Ken

In the Load event of the form enter the following code -


Dim lngCount as Long

ComboBox.Requery
lngCount = ComboBox.ListCount


Substitute the word ComboBox for the name of your combo box control.
This will slow down the initial loading time for the form very
slightly but will speed up the combo box scrolling.

HTH

Peter Hibbs.

 

[Paul Shapiro]

You can use the OnChange event to dynamically load the row source with
filtered values. But the user won't get a dropdown list until they've
entered the number of characters you specify by setting clngNumCharsToQuery.
This example is a combo box where the user selects a person by enterling
"Lastname, Firstname". There is some extra code to separate the entry into
the 2 attributes.
Paul Shapiro

Private Sub cboFind_Change()
'Update the combo box row source based on the typed characters
On Error GoTo ErrorHandler
Dim strText As String, lngNumCharsTyped As Long, lngSelectStart As Long

'Currently displayed text in the combo box
strText = Me.cboFind.Text
lngSelectStart = Me.cboFind.SelStart

'How many of those chars did the user type?
lngNumCharsTyped = Len(strText)
If lngNumCharsTyped > lngSelectStart Then
lngNumCharsTyped = lngSelectStart
End If

If lngNumCharsTyped > 0 Then
Call cboFind_SetRowSource(strSearchInput:=Left(strText,
lngNumCharsTyped))
End If

ExitHandler:
On Error Resume Next
Exit Sub

ErrorHandler:
Select Case Err.Number
Case 2185
'You can't reference a property or method for a control unless the
control has the focus
'This error occurs when the user selects an existing row _
Ignore the error- we don't need to change rowsource anyway
Case Else
'Handle the error here
msgBox "Error happened in cboFind_Change: " & Err.Description
End Select
Resume ExitHandler
Resume
End Sub

Private Sub cboFind_SetRowSource(strSearchInput As String)
'Update the combo box row source to include Persons _
whose 'LastName, FirstName' name starts with the first clngNumCharsToQuery
of strPersonName.
On Error GoTo ErrorHandler
Const clngNumCharsToQuery As Long = 2 'Number of
characters to use in the rowsource query matching clause
Const cstrDelimiter As String = "'" 'SQL text string
delimiter
Static strSearchString As String 'Search string
used in current row source

Dim lngComma As Long 'Location of first
comma in strSearchInput
Dim strSearchLastName As String 'Search string for
the last name
Dim strSearchFirstName As String 'Search string for
the first name
Dim strFilterForm As String, strFilterSearch As String,
strFilterComplete As String
Dim strSQL As String 'SQL row source

'Does the strSearchInput match the current row source search string?
If strSearchString <> Left(strSearchInput, clngNumCharsToQuery) _
Or Len(Me.cboFind.RowSource) = 0 _
Then
'Extract the search characters we want to work with _
and save in a static variable for the above IF clause.
strSearchString = Left(strSearchInput, clngNumCharsToQuery)

'Search condition filter for the combo box rowsource. _
Implement as condition on lastName and firstName so index can be
used.
lngComma = InStr(strSearchString, ",")
If lngComma = 0 Then
'No comma in search string, so last name must start with the
search string
strSearchLastName = Trim(strSearchString)
strSearchFirstName = "" 'No criterion on first name
Else
strSearchLastName = Trim(Left(strSearchString, lngComma - 1))
strSearchFirstName = Trim(Mid(strSearchString, lngComma + 1))
End If

'Build the search criteria for last name
strFilterSearch = pjsBuildCriteriaDelimitedString( _
strFieldname:="perLastName", _
strSearchInput:=strSearchLastName, _
strDelimiter:=cstrDelimiter, _
strOperator:="like", _
strLikeWildCard:="*" _
)

'Is there a first name criterion?
If Len(strSearchFirstName) > 0 Then
strFilterSearch = strFilterSearch _
& " And " & pjsBuildCriteriaDelimitedString( _
strFieldname:="perFirstName", _
strSearchInput:=strSearchFirstName, _
strDelimiter:=cstrDelimiter, _
strOperator:="like", _
strLikeWildCard:="*" _
)
End If

'Retrieve the form's current filter setting, _
which can be set via other controls in the form header
strFilterForm = Me.Filter

'Combine the filter criteria
If Len(strFilterForm) = 0 Then
strFilterComplete = strFilterSearch
Else
strFilterComplete = strFilterSearch & " And " & strFilterForm
End If

'Build the completed sql string
strSQL = "SELECT [personID], [perLastName] & ', ' & [perFirstName]
AS Display " _
& "FROM PERSON " _
& "WHERE " & strFilterComplete _
& "ORDER BY perLastName, perFirstName"

'Set the rowsource
Me.cboFind.RowSource = strSQL
DoEvents 'Hope it finishes the requery...
End If

ExitHandler:
On Error Resume Next
Exit Sub

ErrorHandler:
'Handle the error
msgBox "Error in cboFind_SetRowSource: " & Err.Description
Resume ExitHandler
Resume
End Sub