[RESOLVED] Autocomplete textbox

[Chris001]

Hi, I'm using the code below to create some sort of autocomplete textbox.

swords is an array with more than 100.000 words. Every time the user enters a letter into the textbox (txtWord), it loops though the swords array and uses the Like operator to find matching words and puts them into a listbox (lstWordCheck).

This works fine when the word starts with 'a', but when the word starts with 'z', then with every letter entered into the textbox, it has to loop all the way to the end of the array and that's very slow.

Is there a faster way to find matching words instead of having to loop always from the beginning?

Option Explicit
 
Private blnBackSpace As Boolean
 
Private Sub txtWord_Change()
    Dim i As Long
    Dim x As Long
    
    If Len(txtWord.Text) = 0 Then Exit Sub
    
    If blnBackSpace = True Then
        blnBackSpace = False
        Exit Sub
    End If
    
    lstWordCheck.Clear
    
    For i = LBound(swords) To UBound(swords)
        If swords(i) Like txtWord.Text & "*" Then
            ListAddItem lstWordCheck, swords(i)
            x = x + 1
            If x = 100 Then Exit For
        End If
    Next i
End Sub
 
Private Sub txtWord_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyBack Or KeyCode = vbKeyDelete Then
    If Len(txtWord.Text) <> 0 Then
        blnBackSpace = True
    End If
End If
End Sub

[Siddharth Rout]

Why an array? Why not a listbox or a combobox to store 100,000 words ?

Use sendmessage API as shown in the link below. It is pretty much faster than looping

http://www.vbforums.com/showpost.php...54&postcount=5

[RhinoBull]

Why an array? Why not a listbox or a combobox to store 100,000 words ?

That's a bad idea - if number if items exceeds integer value returned index maybe be (and usually is) incorrect.

[Siddharth Rout]

That's a bad idea - if number if items exceeds integer value returned index maybe be (and usually is) incorrect.

Sorry I didn't get you?

[Chris001]

Thank you, koolsid.

The reason I have a sorted array, is because I need to do other things with the words as well, like fast binary searches.

I just tried your code and it shows the results instantly, but loading more than 100.000 words into an array barely takes 3 seconds (with Split). Loading the words into a listbox or combobox takes minutes, even if I hide the combobox or use LockWindowUpdate. I just tried to load 300.000 words into a combobox and it took more than 5 minutes.

[Siddharth Rout]

I just tried to load 300.000 words into a combobox and it took over 5 minutes.

How and from where are you loading it?

[RhinoBull]

Sorry I didn't get you?

Run this first:

Private Sub Command1_Click()
Dim i As Long

    For i = 0 To 32768
        List1.AddItem i
    Next i
    
    Debug.Print List1.List(List1.ListCount - 1)
    Debug.Print List1.List(List1.ListCount)

End Sub

and then do this:

Private Sub List1_Click()
    Debug.Print List1.List(List1.ListIndex) 'try last item and at least one before
End Sub

[si_the_geek]

The reason I have a sorted array, is because I need to do other things with the words as well, like fast binary searches.

As you are just checking the start of the word, I would use a Binary search for this too.

The result you get from that will be the first match (or the item before it), so you only need to loop from there onwards until you find an item that doesn't match.

[Chris001]

How and from where are you loading it?

I loaded the words by looping through the swords array.

For i = LBound(swords) To UBound(swords)
    Combo1.AddItem swords(i)
Next i

[Chris001]

As you are just checking the start of the word, I would use a Binary search for this too.

The result you get from that will be the first match (or the item before it), so you only need to loop from there onwards until you find an item that doesn't match.

That seems to work fine and is very fast.

Private Sub txtWord_Change()
    Dim i As Long
    Dim x As Long
    Dim lngStart As Long
    
    If Len(txtWord.Text) = 0 Then Exit Sub
    
    If blnBackSpace = True Then
        blnBackSpace = False
        Exit Sub
    End If
    
    lstWordCheck.Clear
    
    lngStart = BinarySearchLike(swords(), txtWord.Text)
    
    If lngStart > 0 Then lngStart = lngStart - 1
    If lngStart = -1 Then Exit Sub
    
    For i = lngStart To UBound(swords)
        If swords(i) Like txtWord.Text & "*" Then
            ListAddItem lstWordCheck, swords(i)
            x = x + 1
            If x = 100 Then Exit For
        End If
    Next i
End Sub

My original BinarySearch function only searched for full words and I changed this.

Public Function BinarySearchLike(strArray() As String, strSearch As String) As Long
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim lngMiddle As Long
    Dim bolInverseOrder As Boolean
    lngFirst = LBound(strArray)
    lngLast = UBound(strArray)
    bolInverseOrder = (strArray(lngFirst) > strArray(lngLast))
    BinarySearchLike = lngFirst - 1
    Do
        lngMiddle = (lngFirst + lngLast) \ 2
        'If strArray(lngMiddle) = strSearch Then
        If strArray(lngMiddle) Like strSearch & "*" Then
            BinarySearchLike = lngMiddle
            Exit Do
        ElseIf ((strArray(lngMiddle) < strSearch) Xor bolInverseOrder) Then
            lngFirst = lngMiddle + 1
        Else
            lngLast = lngMiddle - 1
        End If
    Loop Until lngFirst > lngLast
End Function

[si_the_geek]

I would actually recommend changing the binary search back, because with Like you cannot be sure if it has found the first match or not - it may even be the last one.

If you use the = it will always find the first (or the item before it if it isn't an exact match).



You can also make the loop after it a bit faster, by re-arranging like this:

    For i = lngStart To UBound(swords)
        If NOT swords(i) Like txtWord.Text & "*" Then Exit For
        ListAddItem lstWordCheck, swords(i)
        x = x + 1
        If x = 100 Then Exit For
    Next i

..this way it will exit as soon as a non-matching item is found (as you are checking the left, you shouldn't be able to find any more matches).

[Chris001]

But the problem is that it doesn't return anything until a 100% match has been found.

t = returns nothing (not in the array)
th = returns nothing (not in the array)
the = returns a list of matches starting with the (is in the array)
thec = returns nothing (not in the array)
theca = returns a list of matches starting with theca (is in the array)
thecas = returns nothing (not in the array)

When the user for example types 'thec' into the textbox, I'd like to return everything that starts with 'thec', eventhough the word itself doesn't exist in the array.


Thanks for the improvement.

[si_the_geek]

Ah yes, that is because you only set the functions return value on an exact match.

What I would recommend (so that you can use the function for other purposes too) is add an optional parameter which allows a 'closest' match too, eg:

Public Function BinarySearchLike(strArray() As String, strSearch As String, Optional p_booReturnClosestIfNoMatch as Boolean = False) As Long
...
        If strArray(lngMiddle) = strSearch Then
            BinarySearchLike = lngMiddle
            Exit Function
        ElseIf ((strArray(lngMiddle) < strSearch) Xor bolInverseOrder) Then
            lngFirst = lngMiddle + 1
        Else
            lngLast = lngMiddle - 1
        End If
    Loop Until lngFirst > lngLast

    If p_booReturnClosestIfNoMatch Then
      BinarySearchLike = lngLast  'or maybe lngFirst?
    End If
End Function

[Chris001]

Yes, that works great with lngFirst.

Thank you.