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

UMAKEMESIK

Active Member
Joined
Oct 3, 2005
Messages
371
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.
 

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try this
On sheet 4 the following structure:
Dante Amor
ABCDE
1PathNumberBookSheetCell
2c:\trabajo\booksg-54
Sheet4


Run this macro:
VBA Code:
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

UMAKEMESIK

Active Member
Joined
Oct 3, 2005
Messages
371

ADVERTISEMENT

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:
VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
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

Active Member
Joined
Oct 3, 2005
Messages
371
Again, thankyou.
the change of the word
did the trick

really appreciate
have a nice day.
Happy 4th.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Again with pleasure. Thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,123,354
Messages
5,601,139
Members
414,430
Latest member
jtdinh205

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top