Textbox to search Listbox

[yinkajewole]

I would like to have a code that will search the items in my listbox. The search should not be case sensitive. This is my code

[COLOR=#333333]Private Sub UserForm_Initialize()[/COLOR]Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
MyFolder = "C:\Test"
MyFile = Dir(MyFolder & "\*.xls")
Do While MyFile <> ""
    ListBox1.AddItem MyFile
    MyFile = Dir
Loop [COLOR=#333333]End Sub[/COLOR]

 

[Norie]

Try this code.

Option Explicit
Dim arrAllFiles As Variant

Private Sub TextBox1_Change()
Dim arrFilter As Variant

    If TextBox1.Value = "" Then
        ListBox1.List = arrAllFiles
    End If
    arrFilter = Filter(arrAllFiles, TextBox1.Value, , vbTextCompare)
    
    If UBound(arrFilter) <> -1 Then
        ListBox1.List = arrFilter
    Else
        ListBox1.Clear
    End If
End Sub

Private Sub UserForm_Initialize()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer

    MyFolder = "C:\Test"
    MyFile = Dir(MyFolder & "\*.xls")
    
    Do While MyFile <> ""
        ListBox1.AddItem MyFile
        MyFile = Dir
    Loop
    
    arrAllFiles = ListBox1.List
    
    ReDim Preserve arrAllFiles(0 To ListBox1.ListCount - 1, 0)
    
    arrAllFiles = Application.Transpose(arrAllFiles)
    
End Sub

 

[yinkajewole]

Try this code.

Option Explicit
Dim arrAllFiles As Variant

Private Sub TextBox1_Change()
Dim arrFilter As Variant

    If TextBox1.Value = "" Then
        ListBox1.List = arrAllFiles
    End If
    arrFilter = Filter(arrAllFiles, TextBox1.Value, , vbTextCompare)
    
    If UBound(arrFilter) <> -1 Then
        ListBox1.List = arrFilter
    Else
        ListBox1.Clear
    End If
End Sub

Private Sub UserForm_Initialize()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer

    MyFolder = "C:\Test"
    MyFile = Dir(MyFolder & "\*.xls")
    
    Do While MyFile <> ""
        ListBox1.AddItem MyFile
        MyFile = Dir
    Loop
    
    arrAllFiles = ListBox1.List
    
    ReDim Preserve arrAllFiles(0 To ListBox1.ListCount - 1, 0)
    
    arrAllFiles = Application.Transpose(arrAllFiles)
    
End Sub

I don't like this method, I'll appreciate another code

 

[yinkajewole]

I have cross posted this https://www.excelforum.com/excel-pr...1-search-files-on-listbox-with-a-textbox.html

 

[Norie]

What's wrong with the method?

 

[yinkajewole]

What's wrong with the method?

this line

[COLOR=#333333][I]arrAllFiles = Application.Transpose(arrAllFiles)[/I][/COLOR]

gives me error. Moreover, typing the first letter do not start searching until I type the second letter

 

[Norie]

What error do you get?

Is the listbox populated?

 

[Norie]

I've replace Application.Transpose with a function that should work in VBA outwith Excel.

Option Explicit

Dim arrAllFiles As Variant

Private Sub TextBox1_Change()
Dim arrFilter As Variant

    If TextBox1.Value = "" Then
        ListBox1.List = arrAllFiles
    End If
    arrFilter = Filter(arrAllFiles, TextBox1.Value, , vbTextCompare)
    
    If UBound(arrFilter) <> -1 Then
        ListBox1.List = arrFilter
    Else
        ListBox1.Clear
    End If
End Sub

Private Sub UserForm_Initialize()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer

    MyFolder = "C:\Test"
    MyFile = Dir(MyFolder & "\*.xls")
    
    Do While MyFile <> ""
        ListBox1.AddItem MyFile
        MyFile = Dir
    Loop
    
    arrAllFiles = ListBox1.List
    
    ReDim Preserve arrAllFiles(0 To ListBox1.ListCount - 1, 0)
    
    arrAllFiles = FlattenArray(arrAllFiles)
    
End Sub

Function FlattenArray(arr As Variant) As Variant
Dim arrOut As Variant
Dim I As Long

    ReDim arrOut(LBound(arr, 1) To UBound(arr, 1))
    
    For I = LBound(arrOut, 1) To UBound(arrOut, 1)
        arrOut(I) = arr(I, UBound(arr, 2))
    Next I
    
    FlattenArray = arrOut
    
End Function

 

[yinkajewole]

This is wonderful, I really appreciate this. Many thanks