List Results from All Sheets Search

[caluluaiol]

Hi All,
Hope someone can tell me if it´s possible to create a macro that will search some text value in all sheets from a workbook, and return a list with all that results.

So we have several sheets with different column names, with equipment characteristics. Because equipment's have different names and/or information, in the second row was created a unique TAG, that will represent the same information in all the sheets.

Sheet1...

Sheet2...

So what is needed is that if we Search "A" in ID3, we obtain a list like this... (ignoring all the data in the other columns)

Is this possible?

Thank in advance to anyone who can help in any way.
Regards

 

[HighAndWilder]

Hi All,
Hope someone can tell me if it´s possible to create a macro that will search some text value in all sheets from a workbook, and return a list with all that results.

So we have several sheets with different column names, with equipment characteristics. Because equipment's have different names and/or information, in the second row was created a unique TAG, that will represent the same information in all the sheets.

Sheet1...
View attachment 118918

Sheet2...
View attachment 118919

So what is needed is that if we Search "A" in ID3, we obtain a list like this... (ignoring all the data in the other columns)
View attachment 118920
Is this possible?

Thank in advance to anyone who can help in any way.
Regards

Are there only two variations of which columns ID3 is in?

Can the order of the sheets be changed to facilitate the solution?

 

[caluluaiol]

Are there only two variations of which columns ID3 is in?

Can the order of the sheets be changed to facilitate the solution?

First of All thank you for trying to help.

About first question, the answer is no. Can be more variations at some point. But there is only one column per sheet where that tag appear. So i dont know if its easier to search left to right until you find that Tag, and then stop the search.

Second question, yes you can if that helps to facilitate a solution.
At some point maybe someone will insert a new sheet between, but i believe that with a solution will be more easy to adjust All the process after.

Thank you for your time

 

[MikeVol]

Sheet1

Sheet2

Result Sheet

Result Sheet
Good day. @caluluaiol.
Insert the following code into the Result sheet module.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Or Intersect(Target, Me.Range("A2")) Is Nothing Then Exit Sub
    Dim i           As Long

    Dim ws As Worksheet, resultSheet As Worksheet
    Set resultSheet = ThisWorkbook.Worksheets("Result")

    Dim dict        As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "Result" Then

            Dim dataArr As Variant
            dataArr = ws.UsedRange.Value

            Dim iCol As Long
            iCol = Application.Match(Target.Offset(-1, 0).Value, Application.Index(dataArr, 2, 0), 0)

            If Not IsError(iCol) Then

                For i = 3 To UBound(dataArr, 1)

                    If dataArr(i, iCol) = Target.Value Then
                        dict(dataArr(i, 2) & "|" & dataArr(i, 3)) = Array(dataArr(i, 2), dataArr(i, 3))
                    End If

                Next i

            End If

        End If

    Next ws

    Dim key         As Variant

    Dim resultRow   As Long
    resultRow = 5

    For Each key In dict.Keys
        resultSheet.Cells(resultRow, 1).Value = dict(key)(0)
        resultSheet.Cells(resultRow, 2).Value = dict(key)(1)
        resultRow = resultRow + 1
    Next key

    Application.ScreenUpdating = True
End Sub

The trigger for starting the procedure will be cell A2 on this sheet (Result). I hope you can adapt this code to your range. It was my pleasure to help you. Good luck.

 

[caluluaiol]

View attachment 118934 Sheet1

View attachment 118935Sheet2

View attachment 118936Result Sheet

View attachment 118937Result Sheet
Good day. @caluluaiol.
Insert the following code into the Result sheet module.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Or Intersect(Target, Me.Range("A2")) Is Nothing Then Exit Sub
    Dim i           As Long

    Dim ws As Worksheet, resultSheet As Worksheet
    Set resultSheet = ThisWorkbook.Worksheets("Result")

    Dim dict        As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "Result" Then

            Dim dataArr As Variant
            dataArr = ws.UsedRange.Value

            Dim iCol As Long
            iCol = Application.Match(Target.Offset(-1, 0).Value, Application.Index(dataArr, 2, 0), 0)

            If Not IsError(iCol) Then

                For i = 3 To UBound(dataArr, 1)

                    If dataArr(i, iCol) = Target.Value Then
                        dict(dataArr(i, 2) & "|" & dataArr(i, 3)) = Array(dataArr(i, 2), dataArr(i, 3))
                    End If

                Next i

            End If

        End If

    Next ws

    Dim key         As Variant

    Dim resultRow   As Long
    resultRow = 5

    For Each key In dict.Keys
        resultSheet.Cells(resultRow, 1).Value = dict(key)(0)
        resultSheet.Cells(resultRow, 2).Value = dict(key)(1)
        resultRow = resultRow + 1
    Next key

    Application.ScreenUpdating = True
End Sub

The trigger for starting the procedure will be cell A2 on this sheet (Result). I hope you can adapt this code to your range. It was my pleasure to help you. Good luck.

Thank you so much for your time and help.
This seems to work as intended, but when a change the A2 value from, let´s say A to B, (from one value that as more results than the next one), the value from A7 and A8 still have the same value ( they dont delete). There is anyway to reset first the list and only then populate the B values=?

Example: when put A and then change to B... the Mouse and Battery still appear.

 

[MikeVol]

This happens because you do not clear the range of old data on the Result sheet first. Add the following line to the code:

    Dim ws As Worksheet, resultSheet As Worksheet
    Set resultSheet = ThisWorkbook.Worksheets("Result")

    ' This line will pre-clear the range from old data
    resultSheet.Rows("5:" & resultSheet.Rows.Count).ClearContents

    Dim dict        As Object
    Set dict = CreateObject("Scripting.Dictionary")

 

[caluluaiol]

Thank you so much!

 

[caluluaiol]

This happens because you do not clear the range of old data on the Result sheet first. Add the following line to the code:

    Dim ws As Worksheet, resultSheet As Worksheet
    Set resultSheet = ThisWorkbook.Worksheets("Result")

    ' This line will pre-clear the range from old data
    resultSheet.Rows("5:" & resultSheet.Rows.Count).ClearContents

    Dim dict        As Object
    Set dict = CreateObject("Scripting.Dictionary")

Sorry to bother you again.

If i add a sheet without any ID info in first row (or add a blank sheet), it will give me an error..

Anyway to bypass this?
I try to use

[B]On Error Resume Next[/B]

but that will change the data outcome on Results sheet.

 

[MikeVol]

Ok, the code was written only for 3 sheets. But no problem, we will make some small changes in the code.

        ' We check that we process only sheets "Sheet1" and "Sheet2"
        If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Then
            '        If ws.Name <> "Result" Then

 

[caluluaiol]

Ok, the code was written only for 3 sheets. But no problem, we will make some small changes in the code.

        ' We check that we process only sheets "Sheet1" and "Sheet2"
        If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Then
            '        If ws.Name <> "Result" Then

sorry but that doesn't work.
even with only 2 sheets, it gives me an error.

i think the problem it´s not the number of sheets, i think the error appears when it finds one sheet without the ID03 (search criteria) on the second row.
in the first example if you delete text "ID03" from Sheet1 Cell D2, the error appears