VBA code to filter listbox as you type in a textbox

[BungleNZ]

Hi,

I have a list of customers in listbox1 (the text values of which come from a spreadsheet), that I want to refine as I type in textbox1. I'm not sure if it's possilbe, but I would like it to work similar to the itunes search (if you're familiar with it) where it searchs for any occurance of the text within the list as opposed to just searching for the letters at the beginning of the word.

Thanks in advance to anyone who can help.

 

[Blade Hunter]

The fourth post in this thread:

http://www.mrexcel.com/forum/showthread.php?t=351768

Will do exactly what you want.

Cheers

Dan

Edit: It searches from the left, its an easy change to make it seach for any occurence:

Hang 5 I will update it for you


OK, Download the sheets, edit the code on the form and change

    If UCase(Left(Sheets("Names").Range("A" & X).Value, Len(UserFilter))) = UCase(UserFilter) Then

To

    If InStr(1, UCase(Sheets("Names").Range("A" & X).Value), UCase(UserFilter)) > 0 Then

 

[Blade Hunter]

Meh, Can't edit my post because it is 10 minutes old, grab the sheet from here:

http://www.sendspace.com/file/siioay

and make the above changes at the form level.

 

[BungleNZ]

Thanks for the quick reply and subsequent follow up notes. The functionality of this is good and works as i imagine, do you think it would be easy to adapt the code to remove the requirement of having an extra filtered sheet and just filter the listbox range?

The fourth post in this thread:

http://www.mrexcel.com/forum/showthread.php?t=351768

Will do exactly what you want.

Cheers

Dan

Edit: It searches from the left, its an easy change to make it seach for any occurence:

Hang 5 I will update it for you


OK, Download the sheets, edit the code on the form and change

    If UCase(Left(Sheets("Names").Range("A" & X).Value, Len(UserFilter))) = UCase(UserFilter) Then

To

    If InStr(1, UCase(Sheets("Names").Range("A" & X).Value), UCase(UserFilter)) > 0 Then

 

[Blade Hunter]

Thanks for the quick reply and subsequent follow up notes. The functionality of this is good and works as i imagine, do you think it would be easy to adapt the code to remove the requirement of having an extra filtered sheet and just filter the listbox range?

You could populate the listbox direct from the array like so:

Private Sub UserFilter_Change()
Dim MyList() As Variant
Dim X As Long
Dim Y As Long
Y = 0
For X = 1 To Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row
    If InStr(1, UCase(Sheets("Names").Range("A" & X).Value), UCase(UserFilter)) > 0 Then
        ReDim Preserve MyList(Y)
        MyList(Y) = Sheets("Names").Range("A" & X).Text
        Y = Y + 1
    End If
Next
FilterNames.FilteredList.List = MyList
End Sub
 
Private Sub UserForm_Activate()
    FilterNames.FilteredList.List = Range("A1:A" & Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

 

[BungleNZ]

Ok, that works brilliantly!!! Thank you very much. Two small issues though, both of which should be an easy fix.

1. The list box range starts from cell A2, not cell A1 (ie, there is a header row that I don't want on the list box.)

2. The code generates an error if what is typed in the textbox does not relate to a listbox entry (which makes sense, but it would be best if the listbox just showed as empty instead of resulting in an error.)

Thanks again for your help on this

Edit: I'm an idiot sometimes! Sorted the header row out easy enough, so just the error problem to go now.

You could populate the listbox direct from the array like so:

Private Sub UserFilter_Change()
Dim MyList() As Variant
Dim X As Long
Dim Y As Long
Y = 0
For X = 1 To Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row
    If InStr(1, UCase(Sheets("Names").Range("A" & X).Value), UCase(UserFilter)) > 0 Then
        ReDim Preserve MyList(Y)
        MyList(Y) = Sheets("Names").Range("A" & X).Text
        Y = Y + 1
    End If
Next
FilterNames.FilteredList.List = MyList
End Sub
 
Private Sub UserForm_Activate()
    FilterNames.FilteredList.List = Range("A1:A" & Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

 

[Blade Hunter]

This should do it:

Private Sub UserFilter_Change()
Dim MyList() As Variant
Dim X As Long
Dim Y As Long
Dim FoundSomething As Boolean
FoundSomething = False
Y = 0
For X = 2 To Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row
    If InStr(1, UCase(Sheets("Names").Range("A" & X).Value), UCase(UserFilter)) > 0 Then
        FoundSomething = True
        ReDim Preserve MyList(Y)
        MyList(Y) = Sheets("Names").Range("A" & X).Text
        Y = Y + 1
    End If
Next
If FoundSomething Then
    FilterNames.FilteredList.List = MyList
Else
    FilterNames.FilteredList.Clear
End If
End Sub
 
Private Sub UserForm_Activate()
    FilterNames.FilteredList.List = Range("A2:A" & Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

 

[BungleNZ]

Great, works perfectly. You're a champion!

This should do it:

Private Sub UserFilter_Change()
Dim MyList() As Variant
Dim X As Long
Dim Y As Long
Dim FoundSomething As Boolean
FoundSomething = False
Y = 0
For X = 2 To Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row
    If InStr(1, UCase(Sheets("Names").Range("A" & X).Value), UCase(UserFilter)) > 0 Then
        FoundSomething = True
        ReDim Preserve MyList(Y)
        MyList(Y) = Sheets("Names").Range("A" & X).Text
        Y = Y + 1
    End If
Next
If FoundSomething Then
    FilterNames.FilteredList.List = MyList
Else
    FilterNames.FilteredList.Clear
End If
End Sub
 
Private Sub UserForm_Activate()
    FilterNames.FilteredList.List = Range("A2:A" & Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

 

[Blade Hunter]

Glad I could help .

 

[BungleNZ]

Sorry to muck you around Blade. I've just realised another small problem. To generate the list initially I have written a private function called UniqueItemList (there are repeated customers in the list range and this function only shows unique entries.)

Could you tell me how to use this list (UniqueItemList) in the code you have provided for me?

Glad I could help .