How to search a string in many workbooks and copy row if true

Question

I need to run a report for a customer.

I have approximately 50 files (Excel 2007 workbooks) in a folder. Each workbook has about a hundred rows and ten colums. I need to search a string (in a known column 'c1:c100') "customer name". If this search is positive, then copy this whole row (1:10 columns) to my new report sheet.

I tried recording a macro, but got baffled my the coding and how to make it all variable.

Answer 1

Paste this code into the VBA Explorer and change the path on line 4 to point to the folder containing the files (make sure to include the trailing slash).

This will search all rows and columns. If there are other instances of the search string in different columns than C, it will return those too. It can be modified to only search a single column range but would no longer work if the range changed for some reason.

Sub SearchWB()
    Dim myDir As String, fn As String, ws As Worksheet, r As Range
    Dim a(), n As Long, x As Long, myTask As String, ff As String, temp
    myDir = "C:\test\" '<- change path to folder with files to search
    If Dir(myDir, 16) = "" Then
        MsgBox "No such folder path", 64, myDir
        Exit Sub
    End If
    myTask = InputBox("Enter Customer Name")
    If myTask = "" Then Exit Sub
    x = Columns.Count
    fn = Dir(myDir & "*.xls*")
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Do While fn <> ""
        With Workbooks.Open(myDir & fn, 0)
            For Each ws In .Worksheets
                Set r = ws.Cells.Find(myTask, , , 1)
                If Not r Is Nothing Then
                    ff = r.Address
                    Do
                        n = n + 1
                        temp = r.EntireRow.Value
                        ReDim Preserve temp(1 To 1, 1 To x)
                        ReDim Preserve a(1 To n)
                        a(n) = temp
                        Set r = ws.Cells.FindNext(r)
                    Loop While ff <> r.Address
                End If
            Next
            .Close False
        End With
        fn = Dir
    Loop
    With ThisWorkbook.Sheets(1).Rows(1)
        .CurrentRegion.ClearContents
        If n > 0 Then
            .Resize(n).Value = _
            Application.Transpose(Application.Transpose(a))
        Else
            MsgBox "Not found", , myTask
        End If
    End With
End Sub

Note: this was tested on Excel 2010, but should run fine on 2007. Modified code from this source.