How to search for specific data multiple excel files in a folder

[UMAKEMESIK]

We have a folder with over 300 excel files. The files are forms ( all the same form) and the forms have data entered into them.
we would like to have a search sheet that we can enter a number like (g-54) and run the macros or hit Go and the VB
will go to the folder, open up each form one at a time and look for g-54. if the form finds a match the VB
will list the excel title name on my run sheet from which g-54 was found and list multiple sheets if the number is found
on more than one sheet.

Thanks in advance for any help offered.

 

[DanteAmor]

Try this
On sheet 4 the following structure:

Dante Amor
	A	B	C	D	E
1	Path	Number	Book	Sheet	Cell
2	c:\trabajo\books	g-54
Sheet4

Run this macro:

Sub search_specific_data()
  Dim sPath As String, sNumb As Variant, sFile As Variant
  Dim wb As Workbook, sh As Worksheet
  Dim f As Range, r As Range, cell As String, i As Long
 
  Application.ScreenUpdating = False
  With Sheets("Sheet4")
    sPath = .Range("A2")
    sNumb = .Range("B2")
    .Range("C2:E" & Rows.Count).ClearContents
   
    If sPath = "" Then
      MsgBox "Enter path"
      Exit Sub
    End If
    If Dir(sPath, vbDirectory) = "" Then
      MsgBox "Path does not exists"
      Exit Sub
    End If
    If sNumb = "" Then
      MsgBox "Enter Number"
      Exit Sub
    End If
   
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sFile = Dir(sPath & "*.xls*")
    i = 2
    Do While sFile <> ""
      Set wb = Workbooks.Open(sPath & sFile)
      For Each sh In wb.Sheets
        Set r = sh.Cells
        Set f = r.Find(sNumb, , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          cell = f.Address
          Do
            .Range("C" & i).Value = sFile
            .Range("D" & i).Value = sh.Name
            .Range("E" & i).Value = f.Address
            i = i + 1
            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> cell
        End If
      Next
      wb.Close False
      sFile = Dir()
    Loop
  End With
  Application.ScreenUpdating = True
End Sub

 

[UMAKEMESIK]

Wow, works great!!!
Thanks so much for taking the time

Much appreciated.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[UMAKEMESIK]

Hello,

the code works great and has been a valuable resource

Can this code be modified to look up words

or names

in the b2 entry box.

I tried a word like Wine and wine.com
which is a customer of ours with no results
and im sure they are in there.

I have used entries as pp2323
and it works great, is that becuause there is a number in
the search parameters?

any help would be much appreciated.



Run this macro:

Sub search_specific_data()
  Dim sPath As String, sNumb As Variant, sFile As Variant
  Dim wb As Workbook, sh As Worksheet
  Dim f As Range, r As Range, cell As String, i As Long

  Application.ScreenUpdating = False
  With Sheets("Sheet4")
    sPath = .Range("A2")
    sNumb = .Range("B2")
    .Range("C2:E" & Rows.Count).ClearContents
  
    If sPath = "" Then
      MsgBox "Enter path"
      Exit Sub
    End If
    If Dir(sPath, vbDirectory) = "" Then
      MsgBox "Path does not exists"
      Exit Sub
    End If
    If sNumb = "" Then
      MsgBox "Enter Number"
      Exit Sub
    End If
  
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sFile = Dir(sPath & "*.xls*")
    i = 2
    Do While sFile <> ""
      Set wb = Workbooks.Open(sPath & sFile)
      For Each sh In wb.Sheets
        Set r = sh.Cells
        Set f = r.Find(sNumb, , xlValues, xlWhole, , , False)
        If Not f Is Nothing Then
          cell = f.Address
          Do
            .Range("C" & i).Value = sFile
            .Range("D" & i).Value = sh.Name
            .Range("E" & i).Value = f.Address
            i = i + 1
            Set f = r.FindNext(f)
          Loop While Not f Is Nothing And f.Address <> cell
        End If
      Next
      wb.Close False
      sFile = Dir()
    Loop
  End With
  Application.ScreenUpdating = True
End Sub

[/QUOTE]

 

[DanteAmor]

I tried a word like Wine and wine.com
which is a customer of ours with no results
and im sure they are in there.

Is it there as part of a text inside the cell?
If so, change xlWhole to xlPart in this line:

Set f = r.Find(sNumb, , xlValues, xlWhole, , , False)

 

[UMAKEMESIK]

Again, thankyou.
the change of the word
did the trick

really appreciate
have a nice day.
Happy 4th.

 

[DanteAmor]

Again with pleasure. Thanks for the feedback