Listbox search at any position

Fluff

MrExcel MVP, Moderator
Ok, how about
Code:
Private Sub searchbox_Change()
   Dim Lst As Variant, NLst As Variant
   Dim i As Long, r As Long
   Static Srch As String
   
   If Len(Me.searchbox.Value) < Srch Then
      Me.FileList.Clear
      Call RecursiveFolder(FSO, StartFldr, Me.CheckBox1.Value)
   End If

   Lst = Me.FileList.List
   Srch = Me.searchbox.Value
   ReDim NLst(1 To UBound(Lst), 1 To 2)
   For i = 1 To UBound(Lst)
      If InStr(1, Lst(i, 1), Srch, 1) > 0 Then
         r = r + 1: NLst(r, 1) = Lst(i, 0): NLst(r, 2) = Lst(i, 1)
      End If
   Next i
   Me.FileList.List = NLst
End Sub
 

yinkajewole

Board Regular
Ok, how about
Code:
Private Sub searchbox_Change()
   Dim Lst As Variant, NLst As Variant
   Dim i As Long, r As Long
   Static Srch As String
   
   If Len(Me.searchbox.Value) < Srch Then
      Me.FileList.Clear
      Call RecursiveFolder(FSO, StartFldr, Me.CheckBox1.Value)
   End If

   Lst = Me.FileList.List
   Srch = Me.searchbox.Value
   ReDim NLst(1 To UBound(Lst), 1 To 2)
   For i = 1 To UBound(Lst)
      If InStr(1, Lst(i, 1), Srch, 1) > 0 Then
         r = r + 1: NLst(r, 1) = Lst(i, 0): NLst(r, 2) = Lst(i, 1)
      End If
   Next i
   Me.FileList.List = NLst
End Sub
it worked as expected.
it's just that the search is slow especially the folders that has plenty of files
 

Fluff

MrExcel MVP, Moderator
How about
Code:
Dim FSO As Object
Dim StartFldr As Object
Dim StartPth As String
Dim Lst As Variant

Private Sub CheckBox1_Click()
   Me.FileList.Clear
   Call RecursiveFolder(FSO, StartFldr, Me.CheckBox1.Value)
End Sub

Private Sub UserForm_Initialize()
   
   StartPth = "C:\mrexcel\"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = FSO.getFolder(StartPth)
   Call RecursiveFolder(FSO, StartFldr, False)
   Me.FileList.ColumnWidths = "0;200"
End Sub
Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   Debug.Print Fldr.Name
   For Each FldrFile In Fldr.Files
      If FSO.GetExtensionName(FldrFile) Like "xls*" Then
         With Me.FileList
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
      End If
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
   Lst = Me.FileList.List
End Sub

Private Sub OK_Click()
    Workbooks.Open FileList.Value
End Sub


Private Sub searchbox_Change()
   Dim NLst As Variant
   Dim i As Long, r As Long
   Static Srch As String
   
   If Len(Me.searchbox.Value) < Srch Then
      Me.FileList.List = Lst
   End If

   Lst = Me.FileList.List
   Srch = Me.searchbox.Value
   ReDim NLst(1 To UBound(Lst), 1 To 2)
   For i = 1 To UBound(Lst)
      If InStr(1, Lst(i, 1), Srch, 1) > 0 Then
         r = r + 1: NLst(r, 1) = Lst(i, 0): NLst(r, 2) = Lst(i, 1)
      End If
   Next i
   Me.FileList.List = NLst
End Sub
 

yinkajewole

Board Regular
How about
Code:
Dim FSO As Object
Dim StartFldr As Object
Dim StartPth As String
Dim Lst As Variant

Private Sub CheckBox1_Click()
   Me.FileList.Clear
   Call RecursiveFolder(FSO, StartFldr, Me.CheckBox1.Value)
End Sub

Private Sub UserForm_Initialize()
   
   StartPth = "C:\mrexcel\"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = FSO.getFolder(StartPth)
   Call RecursiveFolder(FSO, StartFldr, False)
   Me.FileList.ColumnWidths = "0;200"
End Sub
Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   Debug.Print Fldr.Name
   For Each FldrFile In Fldr.Files
      If FSO.GetExtensionName(FldrFile) Like "xls*" Then
         With Me.FileList
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
      End If
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
   Lst = Me.FileList.List
End Sub

Private Sub OK_Click()
    Workbooks.Open FileList.Value
End Sub


Private Sub searchbox_Change()
   Dim NLst As Variant
   Dim i As Long, r As Long
   Static Srch As String
   
   If Len(Me.searchbox.Value) < Srch Then
      Me.FileList.List = Lst
   End If

   Lst = Me.FileList.List
   Srch = Me.searchbox.Value
   ReDim NLst(1 To UBound(Lst), 1 To 2)
   For i = 1 To UBound(Lst)
      If InStr(1, Lst(i, 1), Srch, 1) > 0 Then
         r = r + 1: NLst(r, 1) = Lst(i, 0): NLst(r, 2) = Lst(i, 1)
      End If
   Next i
   Me.FileList.List = NLst
End Sub
this is more than great!
thanks
 

Fluff

MrExcel MVP, Moderator
You're welcome & thanks for the feedback
 

Doflamingo

Board Regular
Dear all, sorry to bother but I try to build the userform with the code of @Fluff

In the userform I have a checkbox, the function RecursiveFolder, a commandbutton Ok_Click, the code applied to the userform called UserForm_Initialize
but what is that code searchbox_change ? For a textbox, a listbox ? Let me know if you could give me any clarification :confused:
 

Doflamingo

Board Regular
Hi @yinkajewole, I tried unsuccessfully to reproduce the userform you used with the code of @Fluff. Could you post the file or a screenshot of the userform you used via dropbox ?

Many thanks and kind regards
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top