Filtering a 2D array in a listbox from a textbox

561414

New Member
Joined
Aug 25, 2017
Messages
13
Hi everyone. I have a userform with a textbox and a listbox.
The listbox is populated with data from a 2-column ListObject table whenever the form initializes and, as I type in the textbox, it gets filtered using the full string.
That works, but since I'm filtering construction materials, I have many variations of the same thing, so I would like it to filter using spaces within the string as if they were wildcards.
Example:
If I type "brick", it returns:
  • golden brick || piece
  • concrete brick 2x2x4 || piece
  • painted brick || piece
  • brick for facades || m2
If I type brick and then a space, "brick_", it will return:
  • concrete brick 2x2x4 || piece
  • brick for facades || m2
Because those records have a space after the word "brick", but I want to be able to type, say "bric gol" and return:
  • golden brick || piece
Now, this is my VBA code for the form:
VBA Code:
Private Sub UserForm_Initialize()
Dim myTable As ListObject
Dim myArray As Variant
    ListBox1.ColumnCount = 2
    ListBox1.ColumnWidths = "350,82"
    Set myTable = Worksheets("h_Insumos").ListObjects("tbInsumos")
    myArray = myTable.DataBodyRange
    ListBox1.List = myArray
End Sub

Private Sub TextBox1_Change()
Dim myTable As ListObject
Dim myArray As Variant
Dim results As Variant

    ListBox1.ColumnCount = 2
    ListBox1.ColumnWidths = "350,82"
    Set myTable = Worksheets("h_Insumos").ListObjects("tbInsumos")
    myArray = myTable.DataBodyRange    
    results = filter2dArray(myArray, "*" & TextBox1.Text & "*")    
    If IsEmpty(results) Then
        ListBox1.Clear
    Else
        ListBox1.List = results
    End If

That filter2dArray function might be the problem, but I didn't code it, I grabbed it from here

And it's this:
VBA Code:
Option Compare Text
Public Function filter2dArray(sourceArr As Variant, matchStr As String) As Variant
Dim matchArrIndex As Variant, splitArr As Variant
Dim i As Integer, outerindex As Integer, innerIndex As Integer
Dim tempArrayIndex As Integer, CurrIndex As Integer, stringLength As Integer, matchType As Integer
Dim increaseIndex As Boolean
Dim actualStr As String

splitArr = Split(matchStr, "*")

On Error GoTo errorHandler
    If UBound(splitArr) = 0 Then
        matchType = 0 'Exact Match
        actualStr = matchStr
    ElseIf UBound(splitArr) = 1 And splitArr(1) = "" Then
        matchType = 1 'Starts With
        actualStr = splitArr(0)
    ElseIf UBound(splitArr) = 1 And splitArr(0) = "" Then
        matchType = 2 'ends With
        actualStr = splitArr(1)
    ElseIf UBound(splitArr) = 2 And splitArr(0) = "" And splitArr(2) = "" Then
        matchType = 3 'contains
        actualStr = splitArr(1)
    Else
        MsgBox "Incorrect match provided"
        Exit Function
    End If

    'start index
    i = LBound(sourceArr, 1)
    'resize array for matched values
    ReDim matchArrIndex(LBound(sourceArr, 1) To UBound(sourceArr, 1)) As Variant
    
    'outer loop
    For outerindex = LBound(sourceArr, 1) To UBound(sourceArr, 1)
        'inner loop
        For innerIndex = LBound(sourceArr, 2) To UBound(sourceArr, 2)
            'if string matches with array elements
            If (matchType = 0 And sourceArr(outerindex, innerIndex) = actualStr) Or _
            (matchType = 1 And Left(sourceArr(outerindex, innerIndex), Len(actualStr)) = actualStr) Or _
            (matchType = 2 And Right(sourceArr(outerindex, innerIndex), Len(actualStr)) = actualStr) Or _
            (matchType = 3 And InStr(sourceArr(outerindex, innerIndex), actualStr) <> 0) Then
                increaseIndex = True
                matchArrIndex(i) = outerindex
            End If
        Next
        
        If increaseIndex Then
            tempArrayIndex = tempArrayIndex + 1
            increaseIndex = False
            i = i + 1
        End If
    Next
        
    'if no matches found, exit the function
    If tempArrayIndex = 0 Then
        Exit Function
    End If

    If LBound(sourceArr, 1) = 0 Then
        tempArrayIndex = tempArrayIndex - 1
    End If

    'resize temp array
    ReDim tempArray(LBound(sourceArr, 1) To tempArrayIndex, LBound(sourceArr, 2) To UBound(sourceArr, 2)) As Variant
    CurrIndex = LBound(sourceArr, 1)

    Dim j As Integer
    j = LBound(matchArrIndex)
    'store values in temp array
    For i = CurrIndex To UBound(tempArray)
        For innerIndex = LBound(sourceArr, 2) To UBound(sourceArr, 2)
            tempArray(i, innerIndex) = sourceArr(matchArrIndex(j), innerIndex)
        Next
    j = j + 1
    Next
        
    filter2dArray = tempArray
    Exit Function
errorHandler:
    MsgBox "Error :" & Err.Description
End Function

I have no idea how this third party code works. I already tried modifying the splitArr = Split(matchStr, "*") to splitArr = Split(matchStr, "*", 2) and hoping for it to split the string into 2 parts and evaluate them but it cleared my listbox instead. I'm severely confused. Can anybody tell me how to accomplish this?

Thank you all in advance. If you want a file to test, I will post it no problem.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,961
Office Version
  1. 365
Platform
  1. Windows
You're welcome, glad to help & thanks for the feedback. :)
 

Some videos you may like

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

Watch MrExcel Video

Forum statistics

Threads
1,127,395
Messages
5,624,463
Members
416,029
Latest member
CSM1

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top