Loop between two Arrays and change values based on condition

Question

Instead of using 45 IF conditions , I put my two ranges into variant arrays. Then I used the below code to loop between them and change values of the first array arr1 second elements based on condition. the first range is only 10K rows and the second range is just 45 rows and code takes about 0.7 second to finish. I tried to use Application optimizations like (Calculation, ScreenUpdating ,) but it makes no difference on speed. In advanced grateful for all your help.

Option Explicit
Option Compare Text
 
Sub LoopTwoArrays2()
 
   Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets(1)
   Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets(2)
 
   Dim arg As Range, brg As Range
    Set arg = ws1.Range("P2:Q" & ws1.Cells(Rows.Count, "P").End(xlUp).Row)
    Set brg = ws2.Range("A2:B" & ws2.Cells(Rows.Count, "A").End(xlUp).Row)
 
   Dim arr1 As Variant, arr2 As Variant
    arr1 = arg.Value2
    arr2 = brg.Value2
 
   Dim i As Long, k As Long
    For i = LBound(arr1) To UBound(arr1)
    For k = LBound(arr2) To UBound(arr2)
 
      If arr1(i, 1) = arr2(k, 1) Then
         arr1(i, 2) = arr2(k, 2)
      End If
 
      Next k
    Next i
 
   arg.Value = arr1
 
End Sub

Answer 1

As @Greedo mentioned, it is much simpler to write a formula, be that XLOOKUP or a combination of INDEX and MATCH with fast results and easier maintenance.

However, if you still need to do VBA for whatever reason, then add a reference to Microsoft Scripting Runtime:

and then use something like this:

Option Explicit
Option Compare Text
 
Sub LoopTwoArrays2()
    Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets(1)
    Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets(2)
    
    Dim arg As Range, brg As Range
    Set arg = ws1.Range("P2:Q" & ws1.Cells(Rows.Count, "P").End(xlUp).Row)
    Set brg = ws2.Range("A2:B" & ws2.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Dim arr1() As Variant, arr2() As Variant
    
    RangeToArray arg, arr1
    RangeToArray brg, arr2
    
    Dim i As Long, k As Long
    Dim dict As New Dictionary
    
    For k = UBound(arr2, 1) To LBound(arr2, 1) Step -1
        dict(arr2(k, 1)) = arr2(k, 2)
    Next k
    
    On Error Resume Next
    For i = LBound(arr1, 1) To UBound(arr1, 1)
        arr1(i, 2) = dict(arr1(i, 1))
    Next i
    On Error GoTo 0
    
    arg.Value2 = arr1
End Sub
Private Sub RangeToArray(ByRef rng As Range, ByRef arr() As Variant)
    If rng.Areas(1).Count = 1 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value2
    Else
        arr = rng.Value2
    End If
End Sub

Note that when reading the values from a range you are not guaranteed to get an array hence the need for RangeToArray method.

Also, instead of using:

On Error Resume Next
For i = LBound(arr1, 1) To UBound(arr1, 1)
    arr1(i, 2) = dict(arr1(i, 1))
Next i
On Error GoTo 0

you might want something like:

For i = LBound(arr1, 1) To UBound(arr1, 1)
    If dict.Exists(arr1(i, 1)) Then
        arr1(i, 2) = dict(arr1(i, 1))
    Else
        arr1(i, 2) = Empty 'Or whatever
    End If
Next i

which gives you more control on the return value, if the lookup fails.

Answer 2

(moved from comment as I ran out of editing time)

---

If you have access to the formulas, something like =IFNA(XLOOKUP(P1#,A1#,B1#),Q1#) will probably be faster than anything VBA can do. For the same amount of data you describe it refreshes almost instantly for me*. The formula means "for every id in P, see if it's in A and grab the corresponding value from B, otherwise (IFNA), return the original value from Q".

Advanced: If you sort the IDs in A then you can make things Log(N) faster using a binary search in xlookup.

*_{If I hold down the F9 key it recalculates at a rate of about 10x per second}