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

Macros and VBA

2 Replies

Sort By
  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jul 18, 2024

    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