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:
ref

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}