Analyze Within An Array and Pass Back Once vs. Pass at each applicable Instance

A previous poster posed a problem outlined below (and demanded a programmatic approach, despite multiple attempts to 'nudge' a formulaic approach).

I need a VBA based macro to find all matching jobs which are in Sheet1 column A, in Sheet2 column A and return the corresponding value in column B in Sheet2 to Column B, Sheet 1.

I originally solved his the query (under the disclaimer that an array approach would be more efficient) with a 2x For Each Next; Offset syntax.

I have since reapproached the issue for my own personal development via array. As it is widely held that the most efficient code touches the worksheet the least amount of times, my question is this.

How would my code below (which works) be modified to store all instances of TRUE within the

If varSource(i) = varTarget(j, 1) Then

line within the array and pass those back to the worksheet in one fell swoop.

Full code:

Option Explicit

Sub DoItArray()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rngSource As Range
Dim rngTarget As Range
Dim varSource() As Variant
Dim varTarget() As Variant
Dim i As Integer
Dim j As Integer

calcMode = Application.Calculation
Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")

   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlCalculationManual
   End With

      With ws1
         Set rngSource = .Range("A2", .Range("A2").End(xlDown))
      End With

      With ws2
         Set rngTarget = .Range("A2", .Range("B2").End(xlDown))
      End With

      varSource() = WorksheetFunction.Transpose(rngSource.Value)
      varTarget() = rngTarget.Value

      For i = LBound(varSource) To UBound(varSource)
         For j = LBound(varTarget, 1) To UBound(varTarget, 1)
            If varSource(i) = varTarget(j, 1) Then
               ws1.Cells(i, 2).Value = varTarget(j, 2)
               Exit For
            End If
         Next j
      Next i
      
   With Application
      .ScreenUpdating = True
      .EnableEvents = True
      .Calculation = xlCalculationAutomatic
   End With

End Sub

Friday bump

Friday-Bump

you could just use another array, dimensioned to match the row count and populate that with the values in the loop, then write back to the sheet at the end.

Any chance you could show me how that might possibly look?

AlvaroSiza,

This is how I would do it. It only uses a single array, and uses the .Find method to look for matches and then loads it into the array. It outputs the array at the end:

Sub DoItArray()
    
    Dim CalcMode As Long
    Dim rngFound As Range
    Dim rngList As Range
    Dim arrList As Variant
    Dim i As Long
    
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    'This is the range in Sheet1!A:B
    'We are going to look for matches in Sheet2!A:A for each cell in Sheet1!A:A
    'We are getting the B column so that it is included in the array, as column B will contain the results
    Set rngList = Intersect(Sheets("Sheet1").UsedRange, Sheets("Sheet1").Range("A:B"))
    arrList = rngList.Value2
    
    For i = 1 To UBound(arrList, 1)
	'Perform a .Find for the column A item in the array
        Set rngFound = Sheets("Sheet2").Columns("A").Find(arrList(i, 1), , , xlWhole)
        If Not rngFound Is Nothing Then
	    'Found a match, load the result into column B in the array
            arrList(i, 2) = rngFound.Offset(, 1).Value2
            Set rngFound = Nothing
        End If
    Next i
    
    'Output results
    rngList.Value = arrList
    
    With Application
        .Calculation = CalcMode
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
End Sub