Thread: Changing the data search

Hi
Please Help me make a macro so that it searches for all workbooks, in the same folder.
The file "search-data" now looks for values, but only in one workbook.
I also added a sample data file.
I would like to search the file sheet search_data searched in all files (in my case two).

Regards
kiluk

I ran this code on your search_data.xls file with good results...

Sub Search_All_Worksheets()
    Dim wks         As Worksheet
    Dim rSearch     As Range
    Dim rResults    As Range
    Dim rCriteria   As Range

    With Worksheets("form")
        .Range("A8:G" & .Cells.Rows.Count).Clear
        Set rCriteria = .Range("A1").CurrentRegion

        For Each wks In Worksheets
            Set rResults = .Range("A" & .Cells.Rows.Count).End(xlUp).Offset(1)
            If wks.Name <> "form" Then
                Set rSearch = wks.Range("A2").CurrentRegion
                rSearch.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCriteria
                Set rSearch = rSearch.Offset(1).Resize(rSearch.Rows.Count - 1, 7)

                On Error Resume Next
                rSearch.SpecialCells(xlCellTypeVisible).Copy rResults
                If Err.Number <> 0 Then
                    MsgBox "No results found!", vbExclamation, "Filtration"
                End If

                rSearch.Parent.ShowAllData
                On Error GoTo 0
                Set rSearch = Nothing
            End If
        Next wks
    End With
    Set rCriteria = Nothing
    Set rResults = Nothing
End Sub

Really need this solution, because it would be too much data in one workbook,

So the idea that the data were stored in several files and a separate file from the search engine.

Please help
Kiluk

Let's try this...

Sub Search_Workbooks()
    Dim vFiles      As Variant
    Dim wbk         As Workbook
    Dim x           As Long
    Dim wks         As Worksheet
    Dim rSearch     As Range
    Dim rResults    As Range
    Dim rCriteria   As Range

    vFiles = Application.GetOpenFilename("Excel Files (*.xls), *.xls", Title:="Select files to search", MultiSelect:=True)
    If Not IsArray(vFiles) Then
        MsgBox "No files selected"
        Exit Sub
    End If

    With ThisWorkbook.Worksheets("form")
        .Range("A8:G" & .Cells.Rows.Count).Clear
        Set rCriteria = .Range("A1").CurrentRegion

        For x = 1 To UBound(vFiles)
           Workbooks.Open vFiles(x)
            Set wbk = ActiveWorkbook
            For Each wks In wbk.Worksheets
                Set rResults = .Range("A" & .Cells.Rows.Count).End(xlUp).Offset(1)
                Set rSearch = wks.Range("A2").CurrentRegion
                rSearch.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCriteria
                Set rSearch = rSearch.Offset(1).Resize(rSearch.Rows.Count - 1, 7)

                On Error Resume Next
                rSearch.SpecialCells(xlCellTypeVisible).Copy rResults
                If Err.Number <> 0 Then
                    MsgBox "No results found!", vbExclamation, "Filtration"
                End If

                rSearch.Parent.ShowAllData
                On Error GoTo 0
                Set rSearch = Nothing
            Next wks
        Next x
    End With
    Set rCriteria = Nothing
    Set rResults = Nothing
End Sub

Thanks for your help.
It works almost like I wanted.
I have two comments:
First does not search in a workbook in which the search
Second I would like to macro searched all files in a folder and not those given by me.

kiluk

Try this code...

Sub Search_Workbooks()
    Dim objFileSystem As Object
    Dim objFolder   As Object
    Dim objFile     As Object
    Dim objFileList As Object
    Dim vFiles()    As String        'COLLECTION OF FILE NAMES
    Dim x           As Long

    Dim wbk         As Workbook
    Dim wks         As Worksheet
    Dim rSearch     As Range
    Dim rResults    As Range
    Dim rCriteria   As Range

    'CHANGE PATH AS NEEDED
    Const sPath     As String = "C:\Users\Owner\Downloads\Test"

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFileSystem.GetFolder(sPath)
    Set objFileList = objFolder.Files
    ReDim vFiles(1 To objFileList.Count)
    For Each objFile In objFileList
        If InStr(1, objFile.Name, ".xls") > 0 Then
            x = x + 1
            vFiles(x) = objFile.Name
        End If
    Next objFile
    If x = 0 Then MsgBox "No Excel files found in location " & sPath: Exit Sub
    ReDim Preserve vFiles(1 To x)

    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("form")
        .Range("A8:G" & .Cells.Rows.Count).Clear
        Set rCriteria = .Range("A1").CurrentRegion

        For x = 1 To UBound(vFiles)
            If ThisWorkbook.Name = vFiles(x) Then GoTo Jump
            Workbooks.Open sPath & "\" & vFiles(x)
Jump:
            Set wbk = ActiveWorkbook
            For Each wks In wbk.Worksheets
                Set rResults = .Range("A" & .Cells.Rows.Count).End(xlUp).Offset(1)
                Set rSearch = wks.Range("A2").CurrentRegion
                rSearch.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCriteria
                Set rSearch = rSearch.Offset(1).Resize(rSearch.Rows.Count - 1, 7)

                On Error Resume Next
                rSearch.SpecialCells(xlCellTypeVisible).Copy rResults
                If Err.Number <> 0 Then
                    MsgBox "No results found!", vbExclamation, "Filtration"
                End If

                rSearch.Parent.ShowAllData
                On Error GoTo 0
                Set rSearch = Nothing
            If ThisWorkbook.Name <> vFiles(x) Then wbk.Close SaveChanges:=False
            Next wks
        Next x
    End With
    Set rCriteria = Nothing
    Set rResults = Nothing
    Application.ScreenUpdating = True
End Sub

Hi there.
I thought that everything works, but it is not.
First searches the macro sheet "forms" and paste the line 2 as a result of search.
macro should not browse sheet "forms".
Second Probably does not search all sheets in a directory for all files.
See the attachment. I search "999" in the "PL". Macro has 9 pieces should 12, so thou hast sheets have not been searched.
You can find it because I wrote the column "Number1" Numbering for PL = 999
And the last question. Do not understand the sort of data found.
The macro should start to search from a workbook search_data from data1 sheet, to file the sheet data6 in data_new2 file.

kiluk

One more time...

Sub Search_Workbooks()
    Dim objFileSystem    As Object
    Dim objFolder        As Object
    Dim objFile          As Object
    Dim objFileList      As Object
    Dim vFiles()         As String
    Dim x                As Long

    Dim wbk              As Workbook
    Dim wks              As Worksheet
    Dim rSearch          As Range
    Dim rResults         As Range
    Dim rCriteria        As Range

    'CHANGE PATH AS NEEDED
    Const sPath          As String = "C:\Users\Owner\Downloads\Test"

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFileSystem.GetFolder(sPath)
    Set objFileList = objFolder.Files
    ReDim vFiles(1 To objFileList.Count)
    For Each objFile In objFileList
        If InStr(1, objFile.Name, ".xls") > 0 Then
            x = x + 1
            vFiles(x) = objFile.Name
        End If
    Next objFile
    If x = 0 Then MsgBox "No Excel files found in location " & sPath: Exit Sub
    ReDim Preserve vFiles(1 To x)

    Application.ScreenUpdating = False

    With ThisWorkbook.Worksheets("form")
        .Range("A8:G" & .Cells.Rows.Count).Clear
        Set rCriteria = .Range("A1").CurrentRegion

        For x = 1 To UBound(vFiles)
            If ThisWorkbook.Name = vFiles(x) Then GoTo Jump
            Workbooks.Open sPath & "\" & vFiles(x)
Jump:
            Set wbk = ActiveWorkbook
            For Each wks In wbk.Worksheets
                If wks.Name <> "form" Then
                    Set rResults = .Range("A" & .Cells.Rows.Count).End(xlUp).Offset(1)
                    Set rSearch = wks.Range("A2").CurrentRegion
                    rSearch.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCriteria
                    Set rSearch = rSearch.Offset(1).Resize(rSearch.Rows.Count - 1, 7)

                    On Error Resume Next
                    rSearch.SpecialCells(xlCellTypeVisible).Copy rResults
                    If Err.Number <> 0 Then
                        MsgBox "No results found in " & wks.Parent.Name & "!" & wks.Name, vbExclamation, "Filtration"
                    End If

                    rSearch.Parent.ShowAllData
                    On Error GoTo 0
                    Set rSearch = Nothing
                End If
            Next wks
            If ThisWorkbook.Name <> vFiles(x) Then wbk.Close SaveChanges:=False
        Next x
    End With
    Set rCriteria = Nothing
    Set rResults = Nothing
    Application.ScreenUpdating = True
End Sub

I do not know what to say.
I love it.
thanks a lot

Kiluk

You're welcome. Thanks for the challenge.

I will have many challenges

Kiluk

and if so the columns in sheets were arranged differently.
Can a macro can scan and arrange in a table column in the right order?

kiluk