# Loop between two Arrays and change values based on condition

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


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.

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.

(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