Search Multiple Files in Folder

Likes Likes:  0
Results 1 to 8 of 8

Thread: Search Multiple Files in Folder

  1. #1
    New Member
    Join Date
    Dec 2017
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Search Multiple Files in Folder

     
    Hi,

    I have found the following and modified it a bit but need to modify it a little more for my needs. This allows the user to enter the search criteria and folder to be searched. It then goes through all files in that folder and identifies the files that contain the criteria being searched. I would like to only search in a specified worksheet ("EM") in each workbook. In addition I need to add to the output. Currently this is creating a new tab with four data items. I would also like to return another specified cell from the same row in which the specified data was found. This cell will always be 6 columns to the right of the Found.Address.

    Thanks in advance for the help!

    Code:
    Sub SearchFolders()
        Dim Fso As Object
        Dim Fld As Object
        Dim RngSearch As Range
        Dim StrPath As String
        Dim StrFile As String
        Dim Out As Worksheet
        Dim Wb As Workbook
        Dim Wk As Worksheet
        Dim Row As Long
        Dim Found As Range
        Dim StrAddress As String
        Dim FileDialog As FileDialog
        Dim Update As Boolean
        Dim Count As Long
        On Error GoTo ErrHandler
        Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        FileDialog.AllowMultiSelect = False
        FileDialog.Title = "Select a forlder"
        If FileDialog.Show = -1 Then
            StrPath = FileDialog.SelectedItems(1)
        End If
        If StrPath = "" Then Exit Sub
        Set RngSearch = ActiveWorkbook.Worksheets("Sheet1").Range("B3:E5")
        Update = Application.ScreenUpdating
        Application.ScreenUpdating = False
        Set Out = Worksheets.Add
        Row = 1
        With Out
            .Cells(Row, 1) = "Workbook"
            .Cells(Row, 2) = "Worksheet"
            .Cells(Row, 3) = "Cell Address"
            .Cells(Row, 4) = "Search Criteria"
            .Cells(Row, 5) = "QLE Date"
            Set Fso = CreateObject("Scripting.FileSystemObject")
            Set Fld = Fso.GetFolder(StrPath)
            StrFile = Dir(StrPath & "\*.xls*")
            Do While StrFile <> ""
                Set Wb = Workbooks.Open(Filename:=StrPath & "" & StrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
                For Each Wk In Wb.Worksheets
                    Set Found = Wk.UsedRange.Find(RngSearch)
                    If Not Found Is Nothing Then
                        StrAddress = Found.Address
                    End If
                    Do
                        If Found Is Nothing Then
                            Exit Do
                        Else
                            Count = Count + 1
                            Row = Row + 1
                            .Cells(Row, 1) = Wb.Name
                            .Cells(Row, 2) = Wk.Name
                            .Cells(Row, 3) = Found.Address
                            .Cells(Row, 4) = Found.Value
                            .Cells(Row, 5) = ????
                        End If
                        Set Found = Wk.Cells.FindNext(After:=Found)
                    Loop While StrAddress <> Found.Address
                Next
                Wb.Close (False)
                StrFile = Dir
            Loop
            .Columns("A:D").EntireColumn.AutoFit
        End With
        MsgBox Count & "cells have been found"
    ExitHandler:
        Set Out = Nothing
        Set Wk = Nothing
        Set Wb = Nothing
        Set Fld = Nothing
        Set Fso = Nothing
        Application.ScreenUpdating = Update
        Exit Sub
    ErrHandler:
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End Sub
    Last edited by Macropod; Dec 7th, 2017 at 04:56 PM. Reason: Added code tags

  2. #2
    Moderator Macropod's Avatar
    Join Date
    Aug 2007
    Location
    Canberra, Australia
    Posts
    2,545
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

    After:
    For Each Wk In Wb.Worksheets
    Insert:
    If Wk.Name = "EM" Then
    and after:
    Loop While StrAddress <> Found.Address
    insert:
    Exit For
    End If

    PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    New Member
    Join Date
    Dec 2017
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

    Thanks! That worked perfect for the worksheet question. Any ideas on my second question about pulling additional data from each each worksheet? I need to add to the output. Currently this code is creating a new tab with four data items. I would also like to return another specified cell from the same row in which the Found.Value was found. The cell I want to pull will always be 6 columns to the right of the Found.Address.

    Code:
    Sub SearchFolders()    Dim Fso As Object
        Dim Fld As Object
        Dim RngSearch As Range
        Dim StrPath As String
        Dim StrFile As String
        Dim Out As Worksheet
        Dim Wb As Workbook
        Dim Wk As Worksheet
        Dim Row As Long
        Dim Found As Range
        Dim StrAddress As String
        Dim FileDialog As FileDialog
        Dim Update As Boolean
        Dim Count As Long
        On Error GoTo ErrHandler
        Set FileDialog = Application.FileDialog(msoFileDialogFolderPicker)
        FileDialog.AllowMultiSelect = False
        FileDialog.Title = "Select a forlder"
        If FileDialog.Show = -1 Then
            StrPath = FileDialog.SelectedItems(1)
        End If
        If StrPath = "" Then Exit Sub
        Set RngSearch = ActiveWorkbook.Worksheets("Sheet1").Range("B3:E5")
        Update = Application.ScreenUpdating
        Application.ScreenUpdating = False
        Set Out = Worksheets.Add
        Row = 1
        With Out
            .Cells(Row, 1) = "Workbook"
            .Cells(Row, 2) = "Worksheet"
            .Cells(Row, 3) = "Cell"
            .Cells(Row, 4) = "Text in Cell"
            Set Fso = CreateObject("Scripting.FileSystemObject")
            Set Fld = Fso.GetFolder(StrPath)
            StrFile = Dir(StrPath & "\*.xls*")
            Do While StrFile <> ""
                Set Wb = Workbooks.Open(Filename:=StrPath & "\" & StrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
                For Each Wk In Wb.Worksheets
                    If Wk.Name = "EM" Then
                    Set Found = Wk.UsedRange.Find(RngSearch)
                    If Not Found Is Nothing Then
                        StrAddress = Found.Address
                    End If
                    Do
                        If Found Is Nothing Then
                            Exit Do
                        Else
                            Count = Count + 1
                            Row = Row + 1
                            .Cells(Row, 1) = Wb.Name
                            .Cells(Row, 2) = Wk.Name
                            .Cells(Row, 3) = Found.Address
                            .Cells(Row, 4) = Found.Value
                        End If
                        Set Found = Wk.Cells.FindNext(After:=Found)
                    Loop While StrAddress <> Found.Address
                    Exit For
                    End If
                Next
                Wb.Close (False)
                StrFile = Dir
            Loop
            .Columns("A:D").EntireColumn.AutoFit
        End With
        MsgBox Count & "cells have been found"
    ExitHandler:
        Set Out = Nothing
        Set Wk = Nothing
        Set Wb = Nothing
        Set Fld = Nothing
        Set Fso = Nothing
        Application.ScreenUpdating = Update
        Exit Sub
    ErrHandler:
        MsgBox Err.Description, vbExclamation
        Resume ExitHandler
    End Sub

  4. #4
    Moderator Macropod's Avatar
    Join Date
    Aug 2007
    Location
    Canberra, Australia
    Posts
    2,545
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

    Try:
    .Cells(Row, 5) = Found.Offset(0, 6).Value
    Cheers
    Paul Edstein
    [MS MVP - Word]

  5. #5
    New Member
    Join Date
    Dec 2017
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

    That did it thanks. I am now trying to modify the range that is being searched as the live files have two columns that contain the exact data I am searching.

    I changed the following:

    Code:
    Set Found = Wk.UsedRange.Find(RngSearch)
    to

    Code:
      Set Found = Range("B:B").Find(RngSearch)
    but it is not giving me the expected result of just searching column "B". Any ideas on how to fix this?

    Thanks for all of your help!

  6. #6
    New Member
    Join Date
    Dec 2017
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

    I think I have identified the problem. I modified the following line in addition to the one above and it appears to be working now.

    Code:
    Loop While StrAddress <> Found.Address
    to

    Code:
    Loop While StrAddress = Found.Address

  7. #7
    New Member
    Join Date
    Dec 2017
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

    That did not fix it. Made it worse in fact.

  8. #8
    Moderator Macropod's Avatar
    Join Date
    Aug 2007
    Location
    Canberra, Australia
    Posts
    2,545
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Search Multiple Files in Folder

      
    Set Found = Wk.Range("B:B").Find(RngSearch)
    or:
    Set Found = Wk.Range("B1:B" & Wk.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row).Find(RngSearch)
    Cheers
    Paul Edstein
    [MS MVP - Word]

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com