Excel VBA - Listbox populated with file names - Search and import

[einargud]

Hey folks!

I've made a listbox populated with xlsx files from a specific directory. Inside these excel files are informations about users (name, address, phone numbers, etc.) 9 cells total (A1 to A9).

Let's say the folder which the xlsx files are stored contains about 500 files. Every file looks the same.

My questions are:

How can I search these files (filename) with instant update in listbox? (f.e. if I type the letter 'J' into the searchbox, John will be the only one on the list.)
and
How can I populate cells in Sheet4 (A1 to A9) from a file on the list? (Basically pulling information about John from his xlsx file for example)

Here's what I'm working on.

Here's the code for the listbox.

Private Sub button_load_Click()

[COLOR=#008000]'Code not found 404 :)[/COLOR]

End Sub




Private Sub UserForm_Initialize()
    Dim fileList() As String
    Dim fName As String
    Dim fPath As String
    Dim I As Integer
   [COLOR=#008000]  'define the directory to be searched for files[/COLOR]
    fPath = "C:\Users\Einar Þór\Desktop\Jötunn_excel\_kaupendur\"
     
   [COLOR=#008000]  'build a list of the files[/COLOR]
    fName = Dir(fPath)
    While fName <> ""
        [COLOR=#008000] 'add fName to the list[/COLOR]
        I = I + 1
        ReDim Preserve fileList(1 To I)
        fileList(I) = fName
        [COLOR=#008000] 'get next filename[/COLOR]
        fName = Dir()
    Wend
    [COLOR=#008000] 'see if any files were found[/COLOR]
    If I = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
    [COLOR=#008000] 'cycle through the list and add to listbox[/COLOR]
    For I = 1 To UBound(fileList)
        Me.ListBox1.AddItem fileList(I)
    Next
End Sub

Thank you for your time.

 

[einargud]

are you planning to add a command button for this or how should it work?

Yes. A CommandButton which pulls data from the selected file (Sheet1, cell A1 to A9) to custom named sheet (Cells A1 to A9) on current workbook. Then a Close button to unload userform and go back to the previous one.

Hope you understand



And both of you.. Thank you so much!

 

[VBA Geek]

see if this works for you:

Zippyshare.com - UserFormFilter.xlsb

ps I left some userform controls their default name, but you should try to always rename them so you know what each one is doing
I also assumed that the workbook that you want to open always has a Sheet1, if that might not be the cause then you should trap this error as well

Option Explicit
Private fileList() As String
Private Const strFolder As String = "C:\users\desktop\exccel files\"

Private Sub CommandButton1_Click()
    If IsNull(Me.ListBox1.Value) Then  ' user has not selected anything from the list box
        MsgBox "No Files Were Selected.", vbExclamation
        Exit Sub
    End If
Const SheetName As String = "Data"
Call ImportFile(strFolder & Me.ListBox1.Value, SheetName)
End Sub

Private Sub QuitButton_Click()
    Erase fileList
    Unload Me
End Sub

Private Sub TextBox1_change()
If IsAllocated(fileList) Then
    With Me.TextBox1
        If .Value = vbNullString Then
            Me.ListBox1.List = fileList
        Else
            Me.ListBox1.List = Filter(SourceArray:=fileList, Match:=.Value, Compare:=vbTextCompare)
        End If
    End With
End If
End Sub

Private Sub UserForm_Initialize()
Dim lngCnt As Long
Dim oFile As Scripting.File
Dim oFso As Scripting.FileSystemObject
Dim lngNumOfFiles As Long
Set oFso = New Scripting.FileSystemObject
If oFso.FolderExists(strFolder) = False Then
    MsgBox "Folder " & strFolder & " does not exist.", vbExclamation
    Exit Sub
End If
With oFso.GetFolder(strFolder)
    If .Files.Count = 0 Then
        MsgBox "No Files in " & strFolder
        Exit Sub
    Else
        ReDim fileList(1 To .Files.Count) As String
            For Each oFile In .Files
                lngCnt = lngCnt + 1
                fileList(lngCnt) = oFile.Name
            Next
    End If
End With
Set oFso = Nothing
With Me.ListBox1
    .Object.MultiSelect = 0
    .List = fileList
End With
End Sub

Private Sub ImportFile(strFilePath As String, SheetName As String)
Dim oWB As Workbook
Set oWB = Application.Workbooks.Open(strFilePath)
With oWB
    .Sheets("Sheet1").Range("A1:A9").Copy ThisWorkbook.Sheets(SheetName).Range("A1")
End With
oWB.Close SaveChanges:=False
Set oWB = Nothing
End Sub

Private Function IsAllocated(ByRef vArr As Variant) As Boolean
On Error Resume Next
    IsAllocated = IsArray(vArr) And (LBound(vArr, 1) <= UBound(vArr, 1))
End Function

 

[einargud]

Thank you so much. I will check it out tonight.

Again. Thanks a lot!

Einar

 

[nimesh29]

Hello:
Could either VBA Geek or Einargud re-post the files I am trying to do something very similar.
I have list that is one one worksheet and then I have a button on other sheet. On pressing the button list pops up and I select and insert what I want. However, list is quit long so like to add search button to find and go to that section.

Einargud, how go about adding Logo to your list? that is a nice touch.

-Nimesh

 

[VBA Geek]

Zippyshare.com - UserFormFilter.xlsb

Hello:
Could either VBA Geek or Einargud re-post the files I am trying to do something very similar.
I have list that is one one worksheet and then I have a button on other sheet. On pressing the button list pops up and I select and insert what I want. However, list is quit long so like to add search button to find and go to that section.

Einargud, how go about adding Logo to your list? that is a nice touch.

-Nimesh

 

[nimesh29]

VBZ Geek Thanks for the file.
But, having hard time figuring out filtering to work. if someone could review my file and let and code it would great help.

Link: CSI List
http://we.tl/1ZUqIOjrTk


thanks,
Nimesh