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

 

[MikeVol]

Well, yes, but many nuances emerge that you did not indicate at the beginning of the topic... Replace this line:

            Dim iCol As Long

with this line:

            Dim iCol As Variant

 

[caluluaiol]

Well, yes, but many nuances emerge that you did not indicate at the beginning of the topic... Replace this line:

            Dim iCol As Long

with this line:

            Dim iCol As Variant

Yes, sorry. My fault.
Your code works very well and it´s about what is intended for.

But just trying to provide some variables that may appear in the future. So i am just trying to define better the code.
Thank you

 

[MikeVol]

Okay, no big deal, it happens, but it's better to point out the nuances right away. I was glad to help you. Good luck.

 

[caluluaiol]

Okay, no big deal, it happens, but it's better to point out the nuances right away. I was glad to help you. Good luck.

Sorry to bother you again.
Just one last question .. if the a new column is insert between the ID1 and ID2 , the results are not what expected.

So i try, with your code, to use the ID1 ID2 ID3 as variants too, adding this..

Dim iCol As Variant ' Use Variant to handle both numbers and errors
            Dim iCol2 As Variant
            Dim iCol3 As Variant
            Dim iCol4 As Variant
            iCol = Application.Match(Target.Offset(-1, 0).Value, Application.Index(dataArr, 1, 0), 0)
            iCol2 = Application.Match(Target.Offset(1, 0).Value, Application.Index(dataArr, 1, 0), 0)
            iCol3 = Application.Match(Target.Offset(1, 1).Value, Application.Index(dataArr, 1, 0), 0)
            iCol4 = Application.Match(Target.Offset(1, 2).Value, Application.Index(dataArr, 1, 0), 0)

            If Not IsError(iCol) And Not IsError(iCol2) And Not IsError(iCol3) And Not IsError(iCol4) Then
    
    For i = 3 To UBound(dataArr, 1)
        If dataArr(i, iCol) = Target.Value Then
            dict(dataArr(i, iCol2) & "|" & dataArr(i, iCol3) & "|" & dataArr(i, iCol4)) = Array(dataArr(i, iCol2), dataArr(i, iCol3), dataArr(i, iCol4))
        End If
    Next i

This kind of works, because if the ID1 and ID2 are not together or in same place as the sheet before, it will find them.
My problem is that it instead of give me an array/list of result, it only appear the first one!

I already try several changes but i cannot understand from where the problem come..
Can you help in anyway?

thank you once again.

 

[MikeVol]

If you insert one new column between ID1 and ID2 on all sheets, then it is enough to simply change in this line:

                        dict(dataArr(i, 2) & "|" & dataArr(i, 3)) = Array(dataArr(i, 2), dataArr(i, 3))

to:

                        dict(dataArr(i, 2) & "|" & dataArr(i, 3)) = Array(dataArr(i, 2), dataArr(i, 4))

And you don't need to add anything else to the code if you don't want to see more information on the Result sheet.

 

[caluluaiol]

the problem is that in one sheet can be one new column and the other sheet can be two new columns.
and the location not exact the same, that why i think in some lookup.
probably too complicated i know.

once again sorry to bother. but thank you anyway.

 

[MikeVol]

@caluluaiol

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, key As Variant

    Dim ws As Worksheet, resultSheet As Worksheet
    Set resultSheet = ThisWorkbook.Worksheets("Result")
    resultSheet.Rows("5:" & resultSheet.Rows.Count).ClearContents

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

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name = "Sheet1" Or ws.Name = "Sheet2" Then

            Dim dataArr As Variant
            dataArr = ws.UsedRange.Value

            Dim ID1Index As Variant
            ID1Index = Application.Match(Target.Offset(2, 0).Value, Application.Index(dataArr, 2, 0), 0)

            Dim ID2Index As Variant
            ID2Index = Application.Match(Target.Offset(2, 1).Value, Application.Index(dataArr, 2, 0), 0)

            Dim iCol As Variant
            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, ID1Index), dataArr(i, ID2Index))
                    End If

                Next i

            End If

        End If

    Next ws

    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

    Set dict = Nothing
    Application.ScreenUpdating = True
End Sub