[Share] Filter data on multiple columns and return results to ListBox

[minhthien321]

Today, I would like to introduce and share the code to filter data (about 20,000 rows) on UserForm, search on TextBox and filter data on many columns to return results to ListBox. The code runs fast and smooth.

Option Compare Text

Sub MultiColumnFilter(ByVal strText As String, ByVal lstListBox As MSForms.ListBox, ByVal arrSource, ParamArray arrColNum())
    If Not IsArray(arrSource) Then Exit Sub
    If strText = "" Then
        lstListBox.Column = arrSource
    Else
        Dim arrTmp()
        Dim c As Byte, uc As Byte, v As Byte
        Dim r As Long, ur As Long, n As Long
        ur = UBound(arrSource, 2): uc = UBound(arrSource, 1)
        strText = "*" & strText & "*"
        If LCase(arrColNum(0)) = "all" Then
            For r = 0 To ur
                For c = 0 To uc
                    If arrSource(c, r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        Else
            Dim u As Byte
            u = UBound(arrColNum)
            For r = 0 To ur
                For c = 0 To u
                    If arrSource(arrColNum(c), r) Like strText Then
                        ReDim Preserve arrTmp(0 To uc, 0 To n)
                        For v = 0 To uc
                            arrTmp(v, n) = arrSource(v, r)
                        Next
                        n = n + 1
                        Exit For
                    End If
                Next
            Next
        End If
        If n Then lstListBox.Column = arrTmp Else lstListBox.Clear
    End If
    lstListBox.AddItem Empty
End Sub

Private Sub txtChuoiTK_Change()
    MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 1, 2
End Sub


Private Sub txtChuoiTK_Change()
    MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, "All"
End Sub


Private Sub txtChuoiTK_Change()
    MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 2
End Sub

Code in UserForm:

Option Explicit
Private priArrData

Private Sub txtChuoiTK_Change()
    MultiColumnFilter txtChuoiTK.Text, lstDanhSachVPP, priArrData, 1, 2
End Sub

Private Sub UserForm_Initialize()
    Dim e As Long
    e = DanhSachVPP.Range("A" & DanhSachVPP.Rows.Count).End(xlUp).Row
    lstDanhSachVPP.List = DanhSachVPP.Range("A2:F" & e).Value
    priArrData = lstDanhSachVPP.Column
    lstDanhSachVPP.AddItem Empty
End Sub

Note: My array is designed to be an array starting from 0 (both horizontally and vertically), so if you choose column 1, write it as 0, similar to other columns.

Sorry I can't upload the file