Filter a listbox containing 12 columns using a single searchbox

[JonasTiger]

Hi
I have a userform with a listbox and I want to create a searchbox to filter the listbox while typing.
I was searching for a solution for a similar issue and I found this that thread:

Filter a listbox containing multiple fields/columns using a single searchbox​

Here is a link explaining exactly what I am trying to accomplish using excel. I am trying to use only ONE textbox that will dynamically search (search any character as I type) through multiple columns and have the listbox filter base off of text in...

www.mrexcel.com

But I'm having trouble to adapt the code to my case and I would like help to see what I'm doing wrong:

I have data in a table named "BD_CLIENTES", in a sheet with the same name.
Table BD_CLIENTES has a range "B:M" (12 columns)

I can´t populate the ListBox, the only result I get is data from B col, which is ID_CLIENTES (numeric format),as the picture shows:

Private Sub UserForm_Initialize()
Dim sArr(), SRan As Range
Me.OptionButton1 = True
Set SRan = Range(Range("B2"), Range("B2").End(xlDown).End(xlToRight))
ReDim sArr(1 To SRan.Rows.Count, 1 To SRan.Columns.Count)
sArr = SRan.Value
sArr = bbSort(sArr)

Me.ListBox1.List = sArr

End Sub

Function bbSort(ByVal lArr) As Variant
Dim tTmp
On Error Resume Next
UB2 = UBound(lArr, 2)
On Error GoTo 0
If ISort < 50 And UB2 > 1 Then
    lb0 = LBound(lArr)
    For i = lb0 To UBound(lArr) - 1
        For j = i + 1 To UBound(lArr)
            If UCase(lArr(i, lb0 + ISort)) > UCase(lArr(j, lb0 + ISort)) Then
                For k = LBound(lArr, 2) To UBound(lArr, 2)
                    tTmp = lArr(j, k)
                    lArr(j, k) = lArr(i, k)
                    lArr(i, k) = tTmp
                Next k
            End If
        Next j
    Next i
End If
bbSort = lArr
End Function

Private Sub TextBox1_Change()
'ListBox content is updated whenever the (filter) textbox is modified
Dim SRan As Range, ohYes As Boolean, rCount As Long
'
Set SRan = Range(Range("B2"), Range("B2").End(xlDown).End(xlToRight))  'This is the Row Source
ReDim sArr(1 To SRan.Columns.Count, 1 To SRan.Rows.Count)
For i = 1 To SRan.Rows.Count
    ohYes = False
    For j = 1 To SRan.Columns.Count
        If InStr(1, SRan.Cells(i, j).Value, TextBox1.Value, vbTextCompare) > 0 Then
            ohYes = True
            Exit For
        End If
    Next j
    If ohYes Then
        rCount = rCount + 1
        For j = 1 To SRan.Columns.Count
            sArr(j, rCount) = SRan.Cells(i, j).Value
        Next j
    End If
Next i
'Resize sArr:
If rCount > 0 Then
    ReDim Preserve sArr(1 To j - 1, 1 To rCount)
Else
    ReDim Preserve sArr(1 To j - 1, 1 To 1)
End If
'Sort the array:
If UBound(sArr, 2) > 1 Then
'sArr is a true array:
    sArr = bbSort(Application.WorksheetFunction.Transpose(sArr))     'REMOVE this line if you don't need Sort
    ListBox1.List = sArr
Else
'If one line only it is a bit more complex:
    Me.ListBox1.Clear
    Me.ListBox1.AddItem
    For i = 1 To UBound(sArr)
        Me.ListBox1.Column(i - 1, 0) = sArr(i, 1)
    Next i
End If
End Sub

Thank you very much in advance

 

[RoryA]

A reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

Problem with list box with 12 columns and search textbox

Hi I'm trying to creat a userform with a 12 collumn listbox and with a a search textbox: Database is a table in BD_CLIENTS sheet from col B to col M. I would be very thankful if someone help me with this code (what is wrong?): Private Sub TextBox11_Change() 'Pesquisa Dim i As Long...

chandoo.org

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[JonasTiger]

Very sorry for not mark this thread as cross-post. I didn't think about it. I will be more careful in the futur.

The reason for this new attempt is that the example found in

Filter a listbox containing multiple fields/columns using a single searchbox​

is exactly what I want to implement, but I can't adapt it to my range.

 

[JonasTiger]

I made some progress:
In ListBox Properties, i have defined
Listbox1.ColumnCount - 12
Listbox1.ColumnHeads - True

Now I can populate the listbox.

But when I use the searchbox, column headers disappear and the results are shown vertically:

What is missing?

 

[RoryA]

As you were told previously, you can only use column headers if you use a range and the row source property. They will not work with any other method, such as this array approach.

 

[JCabral]

EXAMPLE FILTER

See if this example helps, I think it can be improved a lot

 

[Anthony47]

First, check that the userform vba module (the one that contains for example the Private Sub TextBox1_Change) on top (before any Sub) contains the line

Private sArr(), iSort As Long

(indeed only iSort is necessary, and deals with selecting the column to be used for sorting; se note ahead)

Second, if your source data come from a table then you should better use the Table as a ListObject to refer to the source range.
This requires that the object sRan be defined in a different way.
Now we use

Set SRan = Range(Range("B2"), Range("B2").End(xlDown).End(xlToRight))  'This is the Row Source

I suggest we use, instead:

Dim aLast As Long 
Set SRan = Sheets("BD_CLIENTES").ListObjects("BD_CLIENTES").Range
aLast = Application.WorksheetFunction.CountA(Application.WorksheetFunction.Index(SRan, 0, 1))
Set SRan = SRan.Resize(aLast)

This is in two places: at Sub UserForm_Initialize and at Sub TextBox1_Change; this definition includes also the header of the table, as per your need

You said that now the headers don't show up, and the data seems to be rotated.
This leads me to assume that you have disabled sorting of data to load in the list box, by removing a line marked " 'REMOVE this line if you don't need Sort"
Well (no: "Bad"), that comment is wrong, because the Sub TextBox1_Change creates a horizontal list (this is because Redim Preserve is used in that Sub, and Preserve requires a horizontal array).

So my suggestion is:
a) restore the sorting instruction
b) modify the line on top of the userform vba module as follows:

Private sArr(), iSort As Long, sFrom As Long

c) modify the Sub UserForm_Initialize as follows:

Private Sub UserForm_Initialize()
Dim sArr(), SRan As Range
iSort = 100                  '100 corresponds to No sorting
sFrom = 2                    '<<< either 1=Sort from line 1 or 2=Sort from line 2
Me.OptionButton1 = True
'Set sRan is modified to refer the Table:
'Set SRan = Range(Range("B2"), Range("B2").End(xlDown).End(xlToRight))
Dim aLast As Long
Set SRan = Sheets("BD_CLIENTES").ListObjects("BD_CLIENTES").Range
aLast = Application.WorksheetFunction.CountA(Application.WorksheetFunction.Index(SRan, 0, 1))
Set SRan = SRan.Resize(aLast)
'
ReDim sArr(1 To SRan.Rows.Count, 1 To SRan.Columns.Count)
sArr = SRan.Value
sArr = bbSort(sArr)
Me.ListBox1.List = sArr
End Sub

d) modify Function bbSort as follows:

Function bbSort(ByVal lArr) As Variant
Dim tTmp
On Error Resume Next
UB2 = UBound(lArr, 2)
On Error GoTo 0
If iSort < 50 And UB2 > 1 Then
    lb0 = LBound(lArr)
    For I = lb0 + (sFrom - 1) To UBound(lArr) - 1
        For j = I + 1 To UBound(lArr)
            If UCase(lArr(I, lb0 + iSort)) > UCase(lArr(j, lb0 + iSort)) Then
                For k = LBound(lArr, 2) To UBound(lArr, 2)
                    tTmp = lArr(j, k)
                    lArr(j, k) = lArr(I, k)
                    lArr(I, k) = tTmp
                Next k
            End If
        Next j
    Next I
End If
bbSort = lArr
End Function

This new bbSort can keep the first line in its position (if it is the header line), and is controlled by sFrom = 2 in the Sub UserForm_Initialize

e) Finally, also Sub TextBox1_Change need to be modified, both to deal with the new definition for SRan and for avoid filtering the header, ie line 1 of the source data:

Private Sub TextBox1_Change()
'ListBox content is updated whenever the (filter) textbox is modified
Dim SRan As Range, ohYes As Boolean, rCount As Long
'
'Set SRan = Range(Range("B2"), Range("B2").End(xlDown).End(xlToRight))  'This is the Row Source
Dim aLast As Long
Set SRan = Sheets("mastro-2022").ListObjects("Tabella1").Range
'Set SRan = Sheets("BD_CLIENTES").ListObjects("BD_CLIENTES").Range
aLast = Application.WorksheetFunction.CountA(Application.WorksheetFunction.Index(SRan, 0, 1))
Set SRan = SRan.Resize(aLast)
'
ReDim sArr(1 To SRan.Columns.Count, 1 To SRan.Rows.Count)
For I = 1 To SRan.Rows.Count
    'Next line: modified to deal with Headers
    If sFrom = 2 And I = 1 Then ohYes = True Else ohYes = False  'deals with the Headers
    For j = 1 To SRan.Columns.Count
        If InStr(1, SRan.Cells(I, j).Value, TextBox1.Value, vbTextCompare) > 0 Then
            ohYes = True
            Exit For
        End If
    Next j
    If ohYes Then
 'the macro continues with its original code

In the workbook that you started from (LBox_Demo.xlsm) there are some OptionButtons that control which column had to be used in the sorting:
OptionButton1 meant No sorting
OptionButton2 meant "use column 1"
OptionButton3 meant "use column 2" and so on
These OptionButtons set the value for variable iSort; if you omit them then in Sub UserForm_Initialize we set iSort to 100, that (in the Function bbSort) means no sort

Hope that I didn't confuse you beyond my will...

 

[JonasTiger]

@Anthony47
Thank you very very much for your help. It works perfect, fast and exactly as I wanted.
Looking now for the complexity of your code, I realize that I have a very long road to walk.

Many thanks to all who replied this thread for your contribution.
JT

 

[Anthony47]

Thank you for your feedback