Solved: Partial String ListBox search to populate another ListBox

[tccmdr]

Hello Gurus :bow:

I have a UserForm ListBox which is poulated from a range in a worksheet.
I have a TextBox above the ListBox in which I enter text. As I enter in each character in the string the first item in the ListBox to match the string is highlighted - like scrolling through the contents.

I have another ListBox in which I want to populate with all items from the first ListBox that match the string, not just the first:think:

So both events will be occuring at the same time, dynamically, as I enter each string character.

Am I missing something simple......all help appreciated: pray2:

[mikerickson]

This assumes that the list in ListBox1 is sorted.
I infer that there are a lot of entries in ListBox1.


Private Sub TextBox1_Change()
Dim dataRRay As Variant
Dim matchingArray As Variant

dataRRay = ArrayFromListBoxOne()

With Me
matchingArray = ArrayOfPartialMatches(dataRRay, .TextBox1.Text)
.ListBox2.List = matchingArray
On Error Resume Next
.ListBox1.ListIndex = Application.Match(.TextBox1.Text & "*", dataRRay, 0) - 1
On Error GoTo 0
End With
End Sub

Function ArrayFromListBoxOne() As Variant
Dim outRRay As Variant, i As Long
With Me.ListBox1
ReDim outRRay(0 To .ListCount - 1)
For i = 0 To .ListCount - 1
outRRay(i) = .List(i)
Next i
End With
ArrayFromListBoxOne = outRRay
End Function

Function ArrayOfPartialMatches(ArrayOfStrings As Variant, ByVal startingString As String) As Variant
Dim outRRay As Variant
Dim minIndex As Long, maxIndex As Long
Dim matchStr As String, i As Long
Dim low As Long, mid As Long, high As Long

startingString = LCase(startingString)

Rem restrict search
matchStr = Left(startingString, 1) & Chr(255)
low = LBound(ArrayOfStrings)
high = UBound(ArrayOfStrings)
Do
mid = (low + high) / 2

If LCase(ArrayOfStrings(mid)) < matchStr Then
low = mid
Else
high = mid
End If
Loop Until high = low + 1
maxIndex = low

matchStr = Chr(Asc(startingString & vbCr) - 1) & Chr(255)
low = LBound(ArrayOfStrings)
high = UBound(ArrayOfStrings)
Do
mid = (low + high) / 2

If LCase(ArrayOfStrings(mid)) < matchStr Then
low = mid
Else
high = mid
End If
Loop Until high = low + 1
minIndex = high + (low = LBound(ArrayOfStrings))

Rem begin search
high = maxIndex - minIndex + 1
mid = 0
If 0 < high Then
ReDim outRRay(1 To high)
For i = minIndex To maxIndex
If LCase(ArrayOfStrings(i)) Like startingString & "*" Then
mid = mid + 1
outRRay(mid) = ArrayOfStrings(i)
End If
Next i
End If

If mid = 0 Then
ReDim outRRay(0 To 0): outRRay(0) = vbNullString
Else
ReDim Preserve outRRay(1 To mid)
End If

ArrayOfPartialMatches = outRRay
End Function

[tccmdr]

Thanks Mike :clap: ......but please don't tell me you just through this together

[mikerickson]

You're welcome.
Once I saw that a sorted list could have the search restricted by a binary search (i.e. neither the restriction nor the search would take forever), the rest was just flowed.