Text Search within directory and return hits

[stolie]

Hi

I would like to be able to create a search form where the user inputs some text eg: abc123 and it searches the available sheets and returns the entire row (and header= row1) into a new sheet.

Im stuck and need help with getting this started. I understand how to assign the macro once its written etc, but my skills lack in the writing the macro . I have searched google and this forum and im more lost then when i started!

Thus breaking it down.

- all books to be searched are within a folder/directory that will not change names.
- there will only ever be 1 sheet per book.
- Preferable if the books remain closed for the search
- 'hits' returned to a new workbook with the corresponding header which will always be row 1. (as the headers between the books vary)

Any assitanace would be appreciated.

 

[jbeaucaire]

Something like this, just edit the fPath to you folder path, it will search every .xls file in that folder for the string you name. It will create a sheet named for that string and list all rows found.

Option Explicit

Sub SearchAll()
Dim MyStr As String, fPath As String, fName As String
Dim wsRpt As Worksheet, wb As Workbook
Dim sFIND As Range, sFIRST As Range

'Setup
    Application.ScreenUpdating = False
    fPath = "C:\2010\"      'remember the final \ in this string
    MyStr = Application.InputBox("What string to search for?", "String Search", "abc123", Type:=2)
    If MyStr = "False" Then Exit Sub

    If Not Evaluate("ISREF('" & MyStr & "'!A1)") Then
        ThisWorkbook.Worksheets.Add.Name = MyStr
    Else
        Sheets(MyStr).UsedRange.Clear
    End If
    
    Set wsRpt = Sheets(MyStr)
    On Error Resume Next

'Loop files
    fName = Dir(fPath & "*.xls")
    
    Do While Len(fName) <> ""
        Set wb = Workbooks.Open(fPath & fName)
        
        Set sFIND = Cells.Find(MyStr, LookIn:=xlValues, LookAt:=xlPart)
        If Not sFIND Is Nothing Then
            Set sFIRST = sFIND
            Rows(1).Copy wsRpt.Range("A" & wsRpt.Rows.Count).End(xlUp).Offset(2)
            
            Do
                sFIND.EntireRow.Copy wsRpt.Range("A" & wsRpt.Rows.Count).End(xlUp).Offset(1)
                Set sFIND = Cells.FindNext(sFIND)
            Loop Until sFIND.Address = sFIRST.Address
            
            Set sFIND = Nothing
            Set sFIRST = Nothing
        End If
        wb.Close False
        
        fName = Dir
    Loop

Application.ScreenUpdating = True
End Sub

 

[stolie]

Thankyou very much for your reply. I have got this working to a point however im having a problem in that it seems to 'hang' once a result is found and doesnt create the result sheet. I thought i might be being impatient, but i tested it on a small sheet of 10 rows and the same thing happens, once i hit escape and debug, the result appears on the sheet .

Thoughts/Solutions ?

Also, each workbook may contain duplicates , will this find all occurances of the text?

Cheers

 

[jbeaucaire]

My sincere apologies, fix this typo:

    Do While Len(fName) > 0

Yes, the macro is designed to find every row where that string is in it, anywhere in the row.

 

[stolie]

My sincere apologies, fix this typo:

    Do While Len(fName) > 0

Yes, the macro is designed to find every row where that string is in it, anywhere in the row.

Fantastic, thanks! No apoligies please, your helping me!

The only thing now is that it doesnt seem to pick up a second hit within the same workbook (file). I have tested by placing the search term in with alternate corresponding data in the row, and only the first instance within each book (file) is being returned.


Thoughts?

 

[jbeaucaire]

No, I when I run it I seem to get all the hits, 2-3 per file in my folder. If you want to contact me through my website link below and send me a couple of sample data files and your master file, I'll test them, see what is going on there.