Results 1 to 1 of 1

Thread: Search Multiple Values

  1. #1
    Neophyte AggyRJ's Avatar
    Join Date
    Jul 2019
    Posts
    1
    Articles
    0
    Excel Version
    Excel 2013

    Search Multiple Values



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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
    Last edited by p45cal; 2019-07-24 at 08:08 PM. Reason: added code tags

Posting Permissions

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