Search column items in multiple sheets

Hello everyone
I have some items in column A in sheet1 ..and I intend to search for each item in the other sheets
The search will be through the used range of the sheet and return the value in the first column of the searched sheets
I have the following code that works well for small amounts of data but in real file it is very very slow so I am searching for a faster way

Sub Search_Column_Items_Across_Multiple_Sheets_Using_Arrays()
    Dim wsh As Worksheet
    Dim ws As Worksheet
    Dim arr As Variant
    Dim a As Variant
    Dim v As Variant
    Dim rng As Range
    Dim i As Long
    Dim x As Long
    
    Set wsh = Worksheets("Sheet1")
    Set rng = wsh.Range(wsh.Range("A2"), wsh.Range("A" & wsh.Rows.Count).End(xlUp))
    arr = rng.Value
    
    For i = 1 To UBound(arr, 1)
        x = -1: Set ws = Nothing
        For Each ws In ThisWorkbook.Worksheets(Array("1", "2"))
            a = ws.Range("A1", ws.Cells(1, 1).SpecialCells(xlLastCell)).Value
            x = SearchIn2DArray(a, CStr(arr(i, 1)))
            If x <> -1 Then Exit For
        Next ws

        If x = -1 Then
            arr(i, 1) = Empty
        Else
            arr(i, 1) = a(x, 1)
        End If
        Erase a
    Next i

    Application.ScreenUpdating = False
        rng.Offset(0, 1).Value = arr
    Application.ScreenUpdating = True
End Sub

Function SearchIn2DArray(vArr As Variant, strCrit As String)
    Dim i As Long
    Dim j As Long

    SearchIn2DArray = -1

    For i = LBound(vArr, 1) To UBound(vArr, 1)
        For j = LBound(vArr, 2) To UBound(vArr, 2)
            If vArr(i, j) = strCrit Then
                SearchIn2DArray = i: GoTo Skipper
            End If
        Next j
    Next i

Skipper:
End Function

* The issue is posted here too
http://www.eileenslounge.com/viewtopic.php?f=30&t=29498

I have changed the UDF to that form

Function SearchIn2DArray(vArr As Variant, strCrit As String)
    Dim i As Long
    Dim j As Long
    Dim x As Variant
    
    SearchIn2DArray = -1

    'For i = LBound(vArr, 1) To UBound(vArr, 1)
        For j = LBound(vArr, 2) To UBound(vArr, 2)
            x = Application.Match(strCrit, Application.Index(vArr, 0, j), 0)
            If Not IsError(x) Then SearchIn2DArray = x: GoTo Skipper
            'If vArr(i, j) = strCrit Then
                'SearchIn2DArray = i: GoTo Skipper
            'End If
        Next j
    'Next i

Skipper:
End Function

But I don't know which is faster :using loops as in the first post or using Index and match as in the second post ..
Can you guide me please?

Thanks a lot Mr. Jindon
So you mean looping through columns using Index and Match is faster than looping through the arrays using Index and Match ?
Can you help me improving the code?

Could this be a little faster ?

Code on ThisWorkbook Module :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  If Sh.Name = "Sheet1" And isChanged Then RefreshZ ""
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Sh.Name <> "Sheet1" Then isChanged = True
End Sub

Code on Standard Module :

Public Z As New Collection, isChanged As Boolean
Sub RefreshZ(param As String)
  Dim ws As Worksheet, a, i As Long, j As Long, s As String, v1, v2
  Set Z = Nothing
  For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Sheet1" Then
         a = ws.Range("A1", ws.Cells(1, 1).SpecialCells(xlLastCell)).Value
         For i = 1 To UBound(a, 1)
             For j = 1 To UBound(a, 2)
                 If Len(a(i, j)) Then
                    s = a(i, j)
                    On Error Resume Next
                       Z.Add key:=s, Item:=Array(s, New Collection)
                    On Error GoTo 0
                    Z(s)(1).Add Array(ws.Name, i, j, a(i, 1))
                 End If
             Next j
         Next i
     End If
  Next ws
  isChanged = False
'  For Each v1 In Z
'      Debug.Print "-------------------------"
'      Debug.Print v1(0)
'      For Each v2 In v1(1)
'          Debug.Print "    " & v2(0) & vbTab & v2(1) & vbTab & v2(2) & vbTab & v2(3)
'      Next v2
'  Next v1
End Sub
Sub Test()
  Dim a, i As Long
  If Z.Count = 0 Then RefreshZ ""
  With Sheets("Sheet1").Range("A1").CurrentRegion
    a = .Columns(1).Value
    For i = 2 To UBound(a, 1)
        On Error Resume Next
           a(i, 1) = Z(a(i, 1))(1)(1)(3)
           If Err.Number <> 0 Then a(i, 1) = vbNullString
        On Error GoTo 0
    Next i
    .Columns(2).Value = a
  End With
End Sub

That's great and fascinating Mr. Karedog
Thank you very very much

I am trying to apply it on the original file now .. Some cells has NA error so I encountered an error at this line

If Len(a(i, j)) Then

How to avoid error cells ? Would I add a line If Not Iserror(a(i, j)) before that line or that may slow down the process?

You are welcome.
I don't think so, it should be nothing (IsError is a builtin VBA function, it should be fast), and beside, the RefreshZ is only called once when refreshing the collection, so it is not depending on how many items on Sheet1!A:A

Sub RefreshZ(param As String)
  Dim ws As Worksheet, a, i As Long, j As Long, s As String, v1, v2
  Set Z = Nothing
  For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Sheet1" Then
         a = ws.Range("A1", ws.Cells(1, 1).SpecialCells(xlLastCell)).Value
         For i = 1 To UBound(a, 1)
             For j = 1 To UBound(a, 2)
                 If Not IsError(a(i, j)) Then
                    If Len(a(i, j)) Then
                       s = a(i, j)
                       On Error Resume Next
                          Z.Add key:=s, Item:=Array(s, New Collection)
                       On Error GoTo 0
                       Z(s)(1).Add Array(ws.Name, i, j, a(i, 1))
                    End If
                 End If
             Next j
         Next i
     End If
  Next ws
  isChanged = False
End Sub

Really amazing. I didn't believe it can be done in that speed
You are amazing my friend

* One last question as for the UDF posted in the first post and the UDF posted in the second post : which is faster ...? or is there another udf that searches 2d array faster than these UDFs

* The main problem solved but I like to have a solution for that part too

Why don't you try to measure it by yourself ?
Just my guess, if number of rows of the array is little, the For..Loop will win, but if many, probably the Application.Match wins (since there is overhead calling a worksheet function).

BTW, if it is possible to use an array formula, then my code can be written as an UDF too (you need to delete all my previous code first) :

Function SearchIt(param As Range, ParamArray dummy())
  Dim Z As New Collection, ws As Worksheet, a, i As Long, j As Long, s As String, v1, v2
  For Each ws In ThisWorkbook.Worksheets
      If ws.Name <> "Sheet1" Then
         a = ws.UsedRange.Value
         For i = 1 To UBound(a, 1)
             For j = 1 To UBound(a, 2)
                 If Not IsError(a(i, j)) Then
                    If Len(a(i, j)) Then
                       s = a(i, j)
                       On Error Resume Next
                          Z.Add key:=s, Item:=Array(s, New Collection)
                       On Error GoTo 0
                       Z(s)(1).Add Array(ws.Name, i, j, a(i, 1))
                    End If
                 End If
             Next j
         Next i
     End If
  Next ws
  a = param.Value
  For i = 1 To UBound(a, 1)
      On Error Resume Next
         a(i, 1) = Z(a(i, 1))(1)(1)(3)
         If Err.Number <> 0 Then a(i, 1) = vbNullString
      On Error GoTo 0
  Next i
  SearchIt = a
End Function

Usage : Array formula on Sheet1!B2:B5 :

Formula:

=searchit(A2:A5,'1'!A:J,'2'!A:J)

or even just :

Formula:

=searchit(A2:A5)

but you must manually recalc the sheet, or insert the Application.Volatile to the UDF

Thanks a lot my friend
I didn't mean the main issue .. It was solved by you completely and it was amazing solution .. I didn't mean to have a solution by converting your code to UDF

* I am talking about searching in 2D array ..
Here's the code

Sub Test()
    Dim a           As Variant
    Dim lr          As Long

    lr = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    a = Range("A1:C" & lr).Value

    MsgBox SearchIn2DArray(a, "Yasser")
End Sub

Function SearchIn2DArray(vArr As Variant, strCrit As String)
    Dim x           As Variant
    Dim i           As Long
    Dim j           As Long

    SearchIn2DArray = -1

    For j = LBound(vArr, 2) To UBound(vArr, 2)
        x = Application.Match(strCrit, Application.Index(vArr, 0, j), 0)
        If Not IsError(x) Then SearchIn2DArray = x: GoTo Skipper
    Next j
Skipper:
End Function

Is that UDF for searching the UDF is faster or not (I would not test .. because I need to know from you the better case) ..
Can this udf that would search 2D arrays ..can we use collections if faster?

Option Explicit

Function SearchIn2DArray_Post1(vArr As Variant, strCrit As String)
    Dim i As Long
    Dim j As Long

    SearchIn2DArray_Post1 = -1

    For i = LBound(vArr, 1) To UBound(vArr, 1)
        For j = LBound(vArr, 2) To UBound(vArr, 2)
            If vArr(i, j) = strCrit Then
                SearchIn2DArray_Post1 = i: GoTo Skipper
            End If
        Next j
    Next i

Skipper:
End Function

Function SearchIn2DArray_Post2(vArr As Variant, strCrit As String)
    Dim i As Long
    Dim j As Long
    Dim x As Variant
    
    SearchIn2DArray_Post2 = -1

    'For i = LBound(vArr, 1) To UBound(vArr, 1)
        For j = LBound(vArr, 2) To UBound(vArr, 2)
            x = Application.Match(strCrit, Application.Index(vArr, 0, j), 0)
            If Not IsError(x) Then SearchIn2DArray_Post2 = x: GoTo Skipper
            'If vArr(i, j) = strCrit Then
                'SearchIn2DArray = i: GoTo Skipper
            'End If
        Next j
    'Next i

Skipper:
End Function

Sub Check()
  Const NumberOfRow = 100
  Dim a(1 To NumberOfRow, 1 To 10), b(1 To 20), d As Double, i As Long, j As Long, p As Long, s As String, x

 '--- Generate array data a, which will be used by two methods ---
  For i = 1 To UBound(a, 1)
      For j = 1 To UBound(a, 2)
          a(i, j) = "Item " & i & " , " & j
      Next j
      DoEvents
  Next i
 '---------------------------------------------------------------------------------

 '--- Generate array "item to be searched" b, which will be used by two methods ---
  p = 0
  For i = UBound(a, 1) - 1 To UBound(a, 1)
      For j = 1 To UBound(a, 2)
          p = p + 1
          b(p) = a(i, j)
      Next j
  Next i
 '---------------------------------------------------------------------------------

 '--- Benchmark using method 1 ---
  d = Timer
  For i = 1 To UBound(b)
      x = SearchIn2DArray_Post1(a, CStr(b(i)))
  Next i
  Debug.Print "Using method 1, run in : " & Format$(Timer - d, "0.00000") & " seconds"
  Debug.Print "Return value of the last item checked = " & x   'Check the last item
 '--------------------------------

 '--- Benchmark using method 2 ---
  d = Timer
  For i = 1 To UBound(b)
      x = SearchIn2DArray_Post2(a, CStr(b(i)))
  Next i
  Debug.Print "Using method 2, run in : " & Format$(Timer - d, "0.00000") & " seconds"
  Debug.Print "Return value of the last item checked = " & x   'Check the last item
 '--------------------------------
End Sub

Well well ...
Here I have set up the test code for both of your UDF (using For..Loop and Application.Match)
Just run the code, and examine the result (I still don't understand why everybody is so afraid of looping)
You can also change number of rows by changing the line with red color, for example from 100 to 10000

As for collection, no, collection won't make the UDF faster if it is used in your SearchIn2DArray() UDF, since this UDF is called as any time as number of items on Sheet1!A:A. In fact, it will be slower, since array operation (a simple variable) is much faster than collection (an object).

Perfect my friend
That's exactly what I was seeking for .. I was seeking for such a demonstration .. Now I would support loops I won't be afraid of loops inside arrays anymore
Thanks a lot for great and incredible help
Best and kind regards

You are welcome, thanks for marking the thread as solved and rep.points.

Regards