JasonPerdue
IS-IT--Management
I have been trying to duplicate ComponentOne's TrueDBGrid FilterBar control for a couple of days now and have finally been successful with the following code. This is a pretty simple way to create a Search Form where a ListBox gets filtered on every letter a user enters into multiple texboxes. You'll have to modify the code to allow for more than three fields to search/filter on.
I'd like to see if this same thing can be accomplished using less code, no queries (I prefer SQL statements), and no unusual VBA References (to keep from having to register dll's and ocx's on user machines).
Hope this proves helpful for someone else...
'Add 3 unbound textboxes named Text1, Text2, Text3
'and 1 unbound ListBox named ctlListBox to a form.
'Modify the following code according to the table
'and fields you're working with.
'---------------------------------------------------------
Option Compare Database
Dim str1, strSQL, strEND As String
Dim tmp1, tmp2, tmp3 As String
'---------------------------------------------------------
Private Function BuildSQL()
str1 = ""
str1 = " Where Field1 Like '" & tmp1 & "*'"
If tmp2 <> "" Then str1 = str1 & " AND YourField2 '" & tmp2 & "*'"
If tmp3 <> "" Then str1 = str1 & " AND YourField3 '" & tmp3 & "*'"
ctlListBox.RowSource = strSQL & str1 & strEND
ctlListBox.Requery
End Function
'---------------------------------------------------------
Private Sub cmdReset_Click()
str1 = ""
tmp1 = ""
tmp2 = ""
tmp3 = ""
Text1.Value = ""
Text2.Value = ""
Text3.Value = ""
strSQL = "SELECT YourField1, YourField2, YourField3 FROM YourTable"
strEND = " ORDER BY YourIndex Desc;"
ctlListBox.RowSource = strSQL & strEND
ctlListBox.Requery
Text1.SetFocus
End Sub
'---------------------------------------------------------
Private Sub Form_Load()
strSQL = "SELECT YourField1, YourField2, YourField3 FROM YourTable"
strEND = " ORDER BY YourIndex Desc;"
ctlListBox.RowSource = strSQL & strEND
ctlListBox.Requery
End Sub
'---------------------------------------------------------
Private Sub Text1_Change()
tmp1 = Text1.Text
Call BuildSQL
End Sub
'---------------------------------------------------------
Private Sub Text2_Change()
tmp2 = Text2.Text
Call BuildSQL
End Sub
'---------------------------------------------------------
Private Sub Text3_Change()
tmp3 = Text3.Text
Call BuildSQL
End Sub
'---------------------------------------------------------
I'd like to see if this same thing can be accomplished using less code, no queries (I prefer SQL statements), and no unusual VBA References (to keep from having to register dll's and ocx's on user machines).
Hope this proves helpful for someone else...
'Add 3 unbound textboxes named Text1, Text2, Text3
'and 1 unbound ListBox named ctlListBox to a form.
'Modify the following code according to the table
'and fields you're working with.
'---------------------------------------------------------
Option Compare Database
Dim str1, strSQL, strEND As String
Dim tmp1, tmp2, tmp3 As String
'---------------------------------------------------------
Private Function BuildSQL()
str1 = ""
str1 = " Where Field1 Like '" & tmp1 & "*'"
If tmp2 <> "" Then str1 = str1 & " AND YourField2 '" & tmp2 & "*'"
If tmp3 <> "" Then str1 = str1 & " AND YourField3 '" & tmp3 & "*'"
ctlListBox.RowSource = strSQL & str1 & strEND
ctlListBox.Requery
End Function
'---------------------------------------------------------
Private Sub cmdReset_Click()
str1 = ""
tmp1 = ""
tmp2 = ""
tmp3 = ""
Text1.Value = ""
Text2.Value = ""
Text3.Value = ""
strSQL = "SELECT YourField1, YourField2, YourField3 FROM YourTable"
strEND = " ORDER BY YourIndex Desc;"
ctlListBox.RowSource = strSQL & strEND
ctlListBox.Requery
Text1.SetFocus
End Sub
'---------------------------------------------------------
Private Sub Form_Load()
strSQL = "SELECT YourField1, YourField2, YourField3 FROM YourTable"
strEND = " ORDER BY YourIndex Desc;"
ctlListBox.RowSource = strSQL & strEND
ctlListBox.Requery
End Sub
'---------------------------------------------------------
Private Sub Text1_Change()
tmp1 = Text1.Text
Call BuildSQL
End Sub
'---------------------------------------------------------
Private Sub Text2_Change()
tmp2 = Text2.Text
Call BuildSQL
End Sub
'---------------------------------------------------------
Private Sub Text3_Change()
tmp3 = Text3.Text
Call BuildSQL
End Sub
'---------------------------------------------------------