Allow users to select from list box based on search terms.
Have a text box and list box in a form, then use below to let users jump to certain item in list box based on their search.
I found the concept of "Jump to" better than "Filter out" items in list box when user wants to find something in a list box
' To call, use
Sub Txt_TeeAdFilter_Change()
Filter_GotoItem FrmL.Txt_TeeAdFilter.Text, "ListBox1"
End Sub
' > > > > > > > > > > > > > > > Function < < < < < < < < < < < < < < < <
Sub Filter_GotoItem(Search4, ListboxName)
List1 = -1
List2 = 0
If Search4 = "" Then GoTo None
ListItemsCount = FrmL.Controls(ListboxName).ListCount
For i = 1 To ListItemsCount
TessID1 = Trim(FrmL.Controls(ListboxName).List(i - 1, 3))
TesSta1 = Trim(FrmL.Controls(ListboxName).List(i - 1, 4))
If InStr(1, TessID1, Search4, vbTextCompare) > 0 Or InStr(1, TesSta1, Search4, vbTextCompare) > 0 Then
Found1 = i
List1 = Found1 - 1
List2 = Found1 - 1
Found2 = Found1 - 6
If Found2 < 0 Then Found2 = 0
If Found1 > 2 Then List2 = Found2
Exit For
End If
Next
None:
FrmL.Controls(ListboxName).ListIndex = List1
If ListItemsCount > 0 Then FrmL.Controls(ListboxName).TopIndex = List2
End Sub
Sub Txt_TeeAdFilter_Change()
Filter_GotoItem FrmL.Txt_TeeAdFilter.Text, "ListBox1"
End Sub
' > > > > > > > > > > > > > > > Function < < < < < < < < < < < < < < < <
Sub Filter_GotoItem(Search4, ListboxName)
List1 = -1
List2 = 0
If Search4 = "" Then GoTo None
ListItemsCount = FrmL.Controls(ListboxName).ListCount
For i = 1 To ListItemsCount
TessID1 = Trim(FrmL.Controls(ListboxName).List(i - 1, 3))
TesSta1 = Trim(FrmL.Controls(ListboxName).List(i - 1, 4))
If InStr(1, TessID1, Search4, vbTextCompare) > 0 Or InStr(1, TesSta1, Search4, vbTextCompare) > 0 Then
Found1 = i
List1 = Found1 - 1
List2 = Found1 - 1
Found2 = Found1 - 6
If Found2 < 0 Then Found2 = 0
If Found1 > 2 Then List2 = Found2
Exit For
End If
Next
None:
FrmL.Controls(ListboxName).ListIndex = List1
If ListItemsCount > 0 Then FrmL.Controls(ListboxName).TopIndex = List2
End Sub
Search4, ListboxName
Views 4,507
Downloads 1,537
CodeID
DB ID
ANmarAmdeen
602
Revisions
v1.0
Thursday
June
7
2018