Forum Discussion

JuanA390's avatar
JuanA390
Copper Contributor
Jul 18, 2024
Solved

Macro to search a list of words in multiple Excel files

Dear all,


I would be grateful if someone could provide me with the code for this problem, or point me in the right direction. I've tried a few codes but I haven't managed to find a solution.

 

I have a list of words in column A of Sheet 1. I would like to search for each of these words in multiple Excel files which are saved in one folder. If any of the words are found in any of the Excel files, I would like to know in which file it was found. In Sheet1 the result would look like this:

 

Column A ---- Column B
Peter        ----- File path/file name
John        ----- Not found
Mary       ----- File path/file name

 

Many thanks in advance,

Juan

2 Replies

  • JuanA390 

    Try this macro:

    Sub SearchFiles()
        ' Change the path but keep the backslash at the end
        Const sFolder = "C:\MyFiles\"
        Dim sFile As String
        Dim wbk As Workbook
        Dim wsh As Worksheet
        Dim rng As Range
        Dim wrd As Range
        Dim cel As Range
        Application.ScreenUpdating = False
        Set wrd = Range(Range("A2"), Range("A1").End(xlDown))
        wrd.Offset(0, 1).Value = "Not Found"
        sFile = Dir(sFolder & "*.xls*")
        Do While sFile <> ""
            Set wbk = Workbooks.Open(Filename:=sFolder & sFile, ReadOnly:=True)
            For Each cel In wrd
                For Each wsh In wbk.Worksheets
                    Set rng = wsh.Cells.Find(What:=cel.Value, _
                        LookIn:=xlValues, LookAt:=xlWhole)
                    If Not rng Is Nothing Then
                        If cel.Offset(0, 1).Value = "Not Found" Then
                            cel.Offset(0, 1).Value = sFolder & sFile
                        Else
                            cel.Offset(0, 1).Value = cel.Offset(0, 1).Value & _
                                vbLf & sFolder & sFile
                        End If
                        Exit For
                    End If
                Next wsh
            Next cel
            wbk.Close SaveChanges:=False
            sFile = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub

Resources