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:
That filter2dArray function might be the problem, but I didn't code it, I grabbed it from here
And it's this:
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.
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:
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 IfThat 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 FunctionI 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.
