MAJOR CHANGE IN FAQ : faq702-6295

[openstar]

hi,
I had to use this FAQ for one of my software, so i made major improvement in the code

No need for developper to adapt code for each new function as before.

Now this fonction work with :
ALL SQL STATEMENT (without changing the code)
ALL WINDOWS LOCAL SETTINGS
ALL NUMBER OF HIDDEN COLUMNS
ALL NUMBER OF BOUND COLUMNS
ALL NUMBER OF COMBOBOX

Need to Add at Top of a Module
Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Need to Add at top of FORM VBA CODE
Dim tempSQLquery As New Collection


PS: i changed the like statement to '*TEXT*' instead of '*T*E*X*T*'
you can change back that in code if necessary.


Here is ComboBox_onchange() code :


Private Sub Combo0_Change() ' Only have to adapt this to your own function

' Function Description:
' Filter a combo box list as the user types,
' I delibarately change code to fit Like "*TEXT*"

' This is accomplished by grabbing the text typed by the user in the
' combo box's edit field, creating an SQL SELECT statement from it,
' and finally applying that SQL statement to the combo box's
' .RowSource property.

' Form design settings:
' Set AutoExpand to No
' Column Count unlimited
' Keyed on column : up to you (record primary key)
' Showing column : up to you (user-readable data)
' Work for as many combobox as possible
' Work independament of local list separator
' No need to know the SQL rowsource

' Need to Add following line at top of Form VBA Code
' Dim tempSQLquery As New Collection

' Need to Add Following line at top of VBA Module Code
' Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

' Written by Sebastien LAUNAY
' Mail launayseb@gmail.com

' Thanks to tek-tips.com for original code

Dim strText As String
Dim strFind As String
Dim rs As DAO.Recordset
Dim FirstField As String
Dim Widths As String
Dim Separator As String
Dim sBuffer As String
Dim rv As Long
Dim separatorCount As Integer
Dim i As Integer
Dim strSQL As String
Dim MyComboBox As ComboBox
Dim myRowSource As String
Dim ErrNumber As Long
Dim SavedRowSource As String

'Get local list separator from system
sBuffer = String$(256, 0)
rv = GetLocaleInfo(&H400, &HC, sBuffer, Len(sBuffer))

If rv > 0 Then
Separator = Left$(sBuffer, rv - 1)
Else

Separator = ""
End If

'Get the active combobox
Set MyComboBox = Screen.ActiveControl

'Get Rowsource
myRowSource = MyComboBox.RowSource

'replace \r\n and Detele space
myRowSource = Replace(myRowSource, Chr(10), " ")
myRowSource = Replace(myRowSource, Chr(13), " ")
myRowSource = Trim(myRowSource)

'take off last listSeparator of Rowsource if exist (for ex : take off ";" in 'SELECT * FROM MyTable;')
If Right(myRowSource, 1) = Separator Then myRowSource = Left(myRowSource, Len(myRowSource) - 1)

'testing if rowsource allready saved
Err.Clear
On Error Resume Next
SavedRowSource = tempSQLquery.Item(MyComboBox.Name)
ErrNumber = CLng(Err.Number)
On Error GoTo 0

'if rowsource never saved -first time- we save it
If ErrNumber > 0 Then tempSQLquery.Add myRowSource, MyComboBox.Name
Err.Clear

' Get the text that the user has typed into the combo box editable field.
strText = MyComboBox.Text

'Get number of first Visible Field
Widths = MyComboBox.ColumnWidths
i = 1
separatorCount = 0
Do While (Mid(Widths, i, 1) <> "1") And (Mid(Widths, i, 1) <> "2") And (Mid(Widths, i, 1) <> "3") And (Mid(Widths, i, 1) <> "4") And (Mid(Widths, i, 1) <> "5") And (Mid(Widths, i, 1) <> "6") And (Mid(Widths, i, 1) <> "7") And (Mid(Widths, i, 1) <> "8") And (Mid(Widths, i, 1) <> "9")
If Mid(Widths, i, 1) = Separator Then separatorCount = separatorCount + 1
i = i + 1
If i > Len(Widths) Then Exit Do
Loop

'Get Name of first Visible Field
Set rs = CurrentDb.OpenRecordset(tempSQLquery.Item(MyComboBox.Name))
FirstField = rs.Fields(separatorCount).Name
rs.Close


' If the user has typed something in, then filter the combobox
' list to limit the visible records to those that contain the
' typed letters.
' Otherwise (if the field is blank), the user has deleted whatever
' text they typed, so show the entire (unfiltered) list
If Len(Trim(strText)) > 0 Then
' Show the list with only those items containing the typed
' letters.

' Create an SQL query string for the WHERE clause of the SQL
' SELECT statement.
strFind = " Like '*" & strText & "*'"

' changing rowsource
MyComboBox.RowSource = "SELECT * FROM (" & tempSQLquery.Item(MyComboBox.Name) & ") WHERE " & FirstField & strFind

Else
MyComboBox.RowSource = tempSQLquery.Item(MyComboBox.Name)
End If

' Make sure the combobox is open so the user
' can see the items available on list.
MyComboBox.Dropdown
End Sub

 

[openstar]

i forget to say that you still have to :

Set autoexpand to No

 

[openstar]

same new function with original search method
LIKE '*T*E*X*T*' instead of LIKE '*TEXT*'

still have to :
set autoexpand to No
add declare function in a module
add collection to form declaration



Private Sub Combo0_Change() ' Only have to adapt this to your own function

' Function Description:
' Filter a combo box list as the user types,
' I delibarately change code to fit Like "*TEXT*"

' This is accomplished by grabbing the text typed by the user in the
' combo box's edit field, creating an SQL SELECT statement from it,
' and finally applying that SQL statement to the combo box's
' .RowSource property.

' Form design settings:
' Set AutoExpand to No
' Column Count unlimited
' Keyed on column : up to you (record primary key)
' Showing column : up to you (user-readable data)
' Work for as many combobox as possible
' Work independament of local list separator
' No need to know the SQL rowsource

' Need to Add following line at top of Form VBA Code
' Dim tempSQLquery As New Collection

' Need to Add Following line at top of VBA Module Code
' Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

' Written by Sebastien LAUNAY
' Mail launayseb@gmail.com

' Thanks to tek-tips.com for original code

Dim strText As String
Dim strFind As String
Dim rs As DAO.Recordset
Dim FirstField As String
Dim Widths As String
Dim Separator As String
Dim sBuffer As String
Dim rv As Long
Dim separatorCount As Integer
Dim i As Integer
Dim strSQL As String
Dim MyComboBox As ComboBox
Dim myRowSource As String
Dim ErrNumber As Long
Dim SavedRowSource As String

'Get local list separator from system
sBuffer = String$(256, 0)
rv = GetLocaleInfo(&H400, &HC, sBuffer, Len(sBuffer))

If rv > 0 Then
Separator = Left$(sBuffer, rv - 1)
Else

Separator = ""
End If

'Get the active combobox
Set MyComboBox = Screen.ActiveControl

'Get Rowsource
myRowSource = MyComboBox.RowSource

'replace \r\n and Detele space
myRowSource = Replace(myRowSource, Chr(10), " ")
myRowSource = Replace(myRowSource, Chr(13), " ")
myRowSource = Trim(myRowSource)

'take off last listSeparator of Rowsource if exist (for ex : take off ";" in 'SELECT * FROM MyTable;')
If Right(myRowSource, 1) = Separator Then myRowSource = Left(myRowSource, Len(myRowSource) - 1)

'testing if rowsource allready saved
Err.Clear
On Error Resume Next
SavedRowSource = tempSQLquery.Item(MyComboBox.Name)
ErrNumber = CLng(Err.Number)
On Error GoTo 0

'if rowsource never saved -first time- we save it
If ErrNumber > 0 Then tempSQLquery.Add myRowSource, MyComboBox.Name
Err.Clear

' Get the text that the user has typed into the combo box editable field.
strText = MyComboBox.Text

'Get number of first Visible Field
Widths = MyComboBox.ColumnWidths
i = 1
separatorCount = 0
Do While (Mid(Widths, i, 1) <> "1") And (Mid(Widths, i, 1) <> "2") And (Mid(Widths, i, 1) <> "3") And (Mid(Widths, i, 1) <> "4") And (Mid(Widths, i, 1) <> "5") And (Mid(Widths, i, 1) <> "6") And (Mid(Widths, i, 1) <> "7") And (Mid(Widths, i, 1) <> "8") And (Mid(Widths, i, 1) <> "9")
If Mid(Widths, i, 1) = Separator Then separatorCount = separatorCount + 1
i = i + 1
If i > Len(Widths) Then Exit Do
Loop

'Get Name of first Visible Field
Set rs = CurrentDb.OpenRecordset(tempSQLquery.Item(MyComboBox.Name))
FirstField = rs.Fields(separatorCount).Name
rs.Close


' If the user has typed something in, then filter the combobox
' list to limit the visible records to those that contain the
' typed letters.
' Otherwise (if the field is blank), the user has deleted whatever
' text they typed, so show the entire (unfiltered) list
If Len(Trim(strText)) > 0 Then
' Show the list with only those items containing the typed
' letters.

' Create an SQL query string for the WHERE clause of the SQL
' SELECT statement.
strFind = " Like '"
For i = 1 To Len(Trim(strText))
If (Right(strFind, 1) = "*") Then
' When adding another character, remove the
' previous "*," otherwise you end up with
' "*g**w*" instead of "*g*w*."
' This has no apparent impact on the user, but
' ensures that the SQL looks as intended.
strFind = Left(strFind, Len(strFind) - 1)
End If
strFind = strFind & "*" & Mid(strText, i, 1) & "*"
Next
strFind = strFind & "'"



' changing rowsource
MyComboBox.RowSource = "SELECT * FROM (" & tempSQLquery.Item(MyComboBox.Name) & ") WHERE " & FirstField & strFind

Else
MyComboBox.RowSource = tempSQLquery.Item(MyComboBox.Name)
End If

' Make sure the combobox is open so the user
' can see the items available on list.
MyComboBox.Dropdown
End Sub

 

[MajP]

You may want to look at Faq702-6304. This turns any combo into a find as you type combobox with one line of code. That is what I would call a major improvement.
example

Public faytProducts As New FindAsYouTypeCombo
Private Sub Form_Load()
  faytProducts.InitalizeFilterCombo Me.cmbProducts, ProductName", False
End Sub

 

[openstar]

it s a bit late here in thailand i will check more your class tomorrow but thanks i think i can improve it.
i didnt used it but read your code.

what do my code and not your code, major improvements of your code i think about :

* you need to know field name to filter.
* your code seems to prevent any use of code in events Change(), GotFocus(), AfterUpdate() of combobox nor Current() on Form
* the fact of changing the filter property will i think not work on complex SQL Query like UNION query or GROUP BY Query
* not sure about this but if you have more than one combobox with filter on same form, i think the Current() event of form will raise an error because can not properly call unfilterlist

what seems not to do neither of your code nor mine (which i changed already but did not post) :

* do not drop down when user select a value from dropdown.

what do your code i do not :

* unfilter after changing value

i check that tomorrow and post new code.

 

[MajP]

Sorry. Most of that is just incorrect.

you need to know field name to filter

Yes, not really sure how that is much of a problem. Not sure how a user could not know the name of the field they plan to filter. However, this could be simply added as a feature by finding the first visible field of the combo.

your code seems to prevent any use of code in events Change(), GotFocus(), AfterUpdate() of combobox nor Current() on Form

That is incorrect. Not sure why you would think that. The class simply traps the onclick event

the fact of changing the filter property will i think not work on complex SQL Query like UNION query or GROUP BY Query

Wrong. Since you filter a value recordset

not sure about this but if you have more than one combobox with filter on same form, i think the Current() event of form will raise an error because can not properly call unfilterlist

No. You can have as many as you want. It filters the recordset of the combo.

The real problem with this code is efficiency on very large recordsets. A filter on a recordset is much more inefficient than calling a new sql

 

[openstar]

Quote:
That is incorrect. Not sure why you would think that. The class simply traps the onclick event

in intitialize :

Set mCombo = TheComboBox ' all modifications to mCombo and mForm will be effective on TheComboBox
Set mForm = TheComboBox.Parent ' and its form. this is not a new instance just a link to the combo and its form
(...)
mForm.OnCurrent = "[Event Procedure]" ' what happen if link to macro ?
mCombnGotFocus = "[Event Procedure]" '
mCombnChange = "[Event Procedure]" '
mCombo.AfterUpdate = "[Event Procedure]" '

then in class methods:

Private Sub mCombo_Change() ' what happen if have code for thoses subs on main code ?
Call FilterList '
End Sub
Private Sub mCombo_GotFocus() '
mCombo.Dropdown '
End Sub
Private Sub mCombo_AfterUpdate() '
Call unFilterList '
End Sub
Private Sub mForm_Current() '
Call unFilterList '
End Sub

Wrong. Since you filter a value recordset

I m not really familiar with .filter coz i prefer to avoid using it, but as far as i read (but can be wrong) it modifies the where clause of SQL (unless it does it after, in such case you are right)

No. You can have as many as you want. It filters the recordset of the combo.

for same reason if have many instance

Private Sub mForm_Current() '
Call unFilterList ' which unFilterlist will be called?
End Sub



speaking of performance ... ok i know it s not really a pb but ... you waste memory instanciating class for life of form

 

[openstar]

Yes, not really sure how that is much of a problem. Not sure how a user could not know the name of the field they plan to filter. However, this could be simply added as a feature by finding the first visible field of the combo.

I do not know, coz i create forms and SQL request dynamically in my program. (i could know but will make much more code for me and loss of perf)
but your right for solution, this is why i implemented it, but need to check system list separator from windows local. works but does not really please me. if have better idea i take it

 

[MajP]

Sorry but obviously you do not understand object oriented and event driven software.

Private Sub mForm_Current() '
Call unFilterList ' which unFilterlist will be called?
End Sub

You are trapping events of instantiated object. Obviously the object whose event was trapped

what happen if have code for those subs on main code ?

Clearly both events would still fire. The form instance and the custom instance. I choose to trap all events, but if there was certain ones you would not want to trap then you could code those out. The concept is ease of use to allow the user to write one line of code and capture all the functionality both from the combo and the form. It does not interfere with existing events.

what happen if link to macro ?

That would be a problem, but few real vba developers use them. If you are using macros then you have more significant issues.

you waste memory instanciating class for life of form

That is just a silly statement. You could probably instantiate a million of these without a noticeable issue. There are a million other things to worry about for memory use then a instantiate of a few simple objects.

but as far as i read (but can be wrong) it modifies the where clause of SQL

Yes you are wrong. It is a filter on the recordset object and does not modify the SQL. It basically creates a new recordset of the filtered results. Therefore, as I said it is inefficient. For most uses the ease of use and reuse outweighs performance. If working with a very large list then you would want to rebuild the sql

 

[openstar]

i do understand how classes and instantiation works

as you see it was more questions
In fact, for many reasons and problems i had in past with it, i never trust microsoft object implementation by default. I would not have asked that with java. i was not sure that both Combo0_Onchange() and the method of the instance of mCombo would be called at same time by microsoft engine.

stays that you overrides .filter but i dont care i never use it and anyway i will change that to another SQLquery.

what i do not understand is how events from an instance to another works, and how an event send by the main combobox cast an event in the instance.
can not be done by
Set mCombo = TheComboBox
(unless i m wrong this ref is a ref to the object thecombobox (for exemple Combo0) which means that it will be catch by Combo0_OnChange() and not mCombo_onChange - unless clause WithEvents tells instance too make a ref for listener when
Set mCombo = TheComboBox)

is this done by office engine when setting
mCombnGotFocus = "[Event Procedure]" making a link for listener in both instance or is this done by With Events clause as describe just before ?

thanks for answering this could help me find a solution not to overide things on object thecombobox by instancing a new combobox object and making a set only on things that needs (like the recordset)

 

[openstar]

is this done by office engine when setting mCombnGotFocus = "[Event Procedure]"

change by :
is this done by office engine when setting mCombnchange = "[Event Procedure]

 

[openstar]

one day i should invest time on how listeners for events work on VB, looks really strange too me, not implemented like in other langages.


This sub does same that your code but :
* work faster (uses a SQL statement)
* allow Macros
* allow use of filter
* do not need to know field name to filter
* is independant of Windows Local settings
* take far less memory in stack due to instancing only collection when control is used. if not used not instanciating
* not intrusive on object expect for .rowsource
* do not drop when value is changed

Ok to say not major change but still changes

PS : i m not really happy with
Set MyComboBox = Screen.ActiveControl
coz if focus on other control or form and onChange() is called... will fail
but cannot get Application.caller on access and Passing Me Byref will just pass the form so if another control of same form call Combo_onchange()... Me.Activecontrol will not be my combobox.
but cannot find how to get caller on vba access. if someone has an idea to work around that pb.


code to put at start of Combo0_Onchange()
call FilterComboBox ' or call FilterComboBox(true)



code to put in a module:

This 2 lines in declaration part of module :

Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Dim tempSQLquery As New Collection



Public Sub FilterComboBox(Optional FilterFromStart = False)

' Function Description:
' Filter a combo box list as the user types,
' I delibarately change code to fit Like "*TEXT*"
' if call with FilterComboBox(true) will filter like "TEXT*"

' This is accomplished by grabbing the text typed by the user in the
' combo box's edit field, creating an SQL SELECT statement from it,
' and finally applying that SQL statement to the combo box's
' .RowSource property.

' Form design settings:
' Set AutoExpand to No
' Column Count unlimited
' Keyed on column : up to you (record primary key)
' Showing column : up to you (user-readable data)
' Work for as many combobox as possible
' Work independament of local list separator
' No need to know the SQL rowsource

' Need to Add following line at top of VBA Code of FORM
' Dim tempSQLquery As New Collection

' Need to Add Following line at top of VBA Code of FORM or Module
' Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

' Written by Sebastien LAUNAY
' Mail launayseb@gmail.com

' Tanks to
Dim strText As String
Dim strFind As String
Dim rs As DAO.Recordset
Dim FirstField As String
Dim Widths As String
Dim Separator As String
Dim sBuffer As String
Dim rv As Long
Dim separatorCount As Integer
Dim i As Integer
Dim strSQL As String
Dim MyComboBox As ComboBox
Dim myRowSource As String
Dim ErrNumber As Long
Dim SavedRowSource As String
Dim myCollec As Collection
'Get local list separator from system
sBuffer = String$(256, 0)
rv = GetLocaleInfo(&H400, &HC, sBuffer, Len(sBuffer))

If rv > 0 Then
Separator = Left$(sBuffer, rv - 1)
Else

Separator = ""
End If

'Get the active combobox
Set MyComboBox = Screen.ActiveControl

'Get Rowsource
myRowSource = MyComboBox.RowSource

'replace \r\n and Detele space
myRowSource = Replace(myRowSource, Chr(10), " ")
myRowSource = Replace(myRowSource, Chr(13), " ")
myRowSource = Trim(myRowSource)

'take off last listSeparator of Rowsource if exist (for ex : take off ";" in 'SELECT * FROM MyTable;')
If Right(myRowSource, 1) = Separator Then myRowSource = Left(myRowSource, Len(myRowSource) - 1)

'testing if rowsource allready saved
Err.Clear
On Error Resume Next
SavedRowSource = tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Item("RowSource")
ErrNumber = CLng(Err.Number)
On Error GoTo 0

'if rowsource never saved -first time- we save it
If ErrNumber > 0 Then
Set myCollec = New Collection
myCollec.Add Null, "LastValue"
myCollec.Add myRowSource, "RowSource"
tempSQLquery.Add myCollec, MyComboBox.Parent.Name & "!!" & MyComboBox.Name
Set myCollec = Nothing
End If
Err.Clear

' Get the text that the user has typed into the combo box editable field.
strText = MyComboBox.Text

'Get number of first Visible Field
Widths = MyComboBox.ColumnWidths
i = 1
separatorCount = 0
Do While (Mid(Widths, i, 1) <> "1") And (Mid(Widths, i, 1) <> "2") And (Mid(Widths, i, 1) <> "3") And (Mid(Widths, i, 1) <> "4") And (Mid(Widths, i, 1) <> "5") And (Mid(Widths, i, 1) <> "6") And (Mid(Widths, i, 1) <> "7") And (Mid(Widths, i, 1) <> "8") And (Mid(Widths, i, 1) <> "9")
If Mid(Widths, i, 1) = Separator Then separatorCount = separatorCount + 1
i = i + 1
If i > Len(Widths) Then Exit Do
Loop

'Get Name of first Visible Field
Set rs = CurrentDb.OpenRecordset(tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Item("RowSource"))
FirstField = rs.Fields(separatorCount).Name
rs.Close


' If the user has typed something in, then filter the combobox
' list to limit the visible records to those that contain the
' typed letters.
' Otherwise (if the field is blank), the user has deleted whatever
' text they typed, so show the entire (unfiltered) list
If Len(Trim(strText)) > 0 Then
' Show the list with only those items containing the typed
' letters.

' Create an SQL query string for the WHERE clause of the SQL
' SELECT statement.
If FilterFromStart Then strFind = " Like '" & strText & "*'" Else strFind = " Like '*" & strText & "*'"

' changing rowsource
MyComboBox.RowSource = "SELECT * FROM (" & tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Item("RowSource") & ") WHERE " & FirstField & strFind

Else
MyComboBox.RowSource = tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Item("RowSource")
End If

' Make sure the combobox is open so the user
' can see the items available on list.



If (tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Item("LastValue") = MyComboBox.Value) Or (IsNull(MyComboBox.Value)) Then
MyComboBox.Dropdown
Else
MyComboBox.RowSource = tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Item("RowSource")
End If

tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Remove "LastValue"
tempSQLquery.Item(MyComboBox.Parent.Name & "!!" & MyComboBox.Name).Add MyComboBox.Value, "LastValue"
End Sub