Search Multiple Values

AggyRJ · Jul 24, 2019

I need to be able to search for a value across multiple workbooks and have a list returned of the name of the workbook and the cell address where it was found. At this point I have been able to find a vba that does this, however it only allows me to search for one value. I need to be able to have a list that starts at cell A5 and ends at A20. The code should perform the search and return the information for the value found in A5, then A6, then A7, etc.

As of right now the code that I am posting below does everything I want with one exception - I do not know how to write a loop that will go through the entire list, only one value. You can see where I have set the variable strSearch to cell E5 (strSearch = Range("A5").Text. I would like to have this code work exactly as it does, but once it performs the search for the value in A5, loop back and do it again using the value in A6, then A7...

Any help on this is greatly appreciated.

Code:

Sub SearchFolders()
    Dim fso As Object
    Dim fld As Object
    Dim strSearch As String
    Dim strPath As String
    Dim strFile As String
    Dim wOut As Worksheet
    Dim wbk As Workbook
    Dim wks As Worksheet
    Dim lRow As Long
    Dim rFound As Range
    Dim strFirstAddress As String

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False


    strPath = "\\RETUS379-NT0002\ROJOS4$\Desktop\TEST"
    strSearch = Range("A5").Text

    Set wOut = Worksheets.Add
    lRow = 1
    With wOut
        .Cells(lRow, 1) = "Workbook"
        .Cells(lRow, 2) = "Worksheet"
        .Cells(lRow, 3) = "Cell"
        .Cells(lRow, 4) = "Text in Cell"
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set fld = fso.GetFolder(strPath)

        strFile = Dir(strPath & "\*.xls*")
        Do While strFile <> ""
            Set wbk = Workbooks.Open _
              (Filename:=strPath & "" & strFile, _
              UpdateLinks:=0, _
              ReadOnly:=True, _
              AddToMRU:=False)

            For Each wks In wbk.Worksheets
                Set rFound = wks.UsedRange.Find(strSearch)
                If Not rFound Is Nothing Then
                    strFirstAddress = rFound.Address
                End If
                Do
                    If rFound Is Nothing Then
                        Exit Do
                    Else
                        lRow = lRow + 1
                        .Cells(lRow, 1) = wbk.Name
                        .Cells(lRow, 2) = wks.Name
                        .Cells(lRow, 3) = rFound.Address
                        .Cells(lRow, 4) = rFound.Value
                    End If
                    Set rFound = wks.Cells.FindNext(After:=rFound)
                Loop While strFirstAddress <> rFound.Address
            Next

            wbk.Close (False)
            strFile = Dir
        Loop
        .Columns("A:D").EntireColumn.AutoFit
    End With
    MsgBox "Done"

 ExitHandler:
    Set wOut = Nothing
    Set wks = Nothing
    Set wbk = Nothing
    Set fld = Nothing
    Set fso = Nothing
    Application.ScreenUpdating = True
    Exit Sub

 ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
 End Sub

Smarter · Aug 30, 2019

Not sure where you want to start the loop
StrPath or Strserach ?

put it like

for i = 5 to 20
strSearch = Range("A")&i

[your code and action need ]
...
...
...

[your code for last command of this loop]
next i

Search Multiple Values

AggyRJ

New member

Smarter

New member