VBA: faster way to compare two ranges?

Question

I need to compare two ranges and see if value in one range appears in the other. This is the code I use:

Dim rng1 As Range
Dim rng2 As Range
Dim cell as Range
Dim found as Range

set rng1 = ....
set rng2 = ....
for each cell in rng1
set found = rng2.Find(what:=cell,.....
Next cell

This code is OK if the range is in thousands of rows, single column. When it comes to tens of thousands, it's very slow.

Anyway to speed it up?

Answer 1

This might be the fastest way for large amounts of data:

Option Explicit
Sub Test()

    Dim rng1 As Range
    Set rng1 = YourShorterRange

    Dim rng2 As Range
    Set rng2 = YourLargerRange

    Dim C As Range
    Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
    'input the larger data inside a dictionary
    For Each C In rng2
        If Not Matches.Exists(C.Value) Then Matches.Add C.Value, 1
    Next C

    Dim i As Long
    Dim arr As Variant
    'input the shorter data inside an array
    arr = rng1.Value
    For i = 1 To UBound(arr)
        If Matches.Exists(arr(i, 1)) Then
            'your code if the value is found
        End If
    Next i

End Sub

Edit for Dorian:

Option Explicit
Sub Test()

    Dim rng1 As Range
    Set rng1 = YourShorterRange

    Dim rng2 As Range
    Set rng2 = YourLargerRange

    Dim i As Long, j As Long
    Dim arr As Variant
    Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
    arr = rng1.Value
    'input the larger data inside a dictionary
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
        Next j
    Next i

    'input the shorter data inside an array
    arr = rng2.Value
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Matches.Exists(arr(i, j)) Then
                'your code if the value is found
            End If
        Next j
    Next i

End Sub

Answer 2

Maybe something along these lines:

Sub Test()

Dim arr1 As Variant, arr2 As Variant
Dim arrList As Object: Set arrList = CreateObject("System.Collections.ArrayList")
Dim x As Long

arr1 = rng1 'Specify your range
arr2 = rng2 'Specify your range

For x = LBound(arr2) To UBound(arr2)
    arrList.Add arr2(x, 1)
Next x

For x = LBound(arr1) To UBound(arr1)
    If arrList.contains(arr1(x, 1)) = True Then
        Debug.Print arr1(x, 1) & " contained within range 2"
    End If
Next x

End Sub

Answer 3

I would suggest you :

Application.match

You can also look here you will find an interesting studies on 3 different ways of Search. Those 3 Different way will be studied By Time and By number of occurences.

According Fastexcel the conclusion of this study is :

Don’t use Range.Find unless you want to search a large number of columns for the same thing (you would have to do a Match for each column).

The Variant array approach is surprisingly effective, particularly when you expect a large number of hits.

Match wins easily for a small number of hits.

So If you except a large number of hit you might have to give a try variant array method. The 3 ways are listed in Fastexcel tuto

Edit

After reading some comment I did a new test :

Variant code

Sub Test1()
Dim vArr As Variant
Dim j As Long
Dim n As Long
Dim dTime As Double
dTime = MicroTimer
vArr = Range("A1:B100000").Value2

Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
arr = Range("G1:G15").Value
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
        Next j
    Next i

For j = LBound(vArr) To UBound(vArr)
If Matches.Exists(vArr(j, 1)) Or Matches.Exists(vArr(j, 2)) Then n = n + 1
Next j
Debug.Print "Using Variant : " & n & " Timer :" & (MicroTimer - dTime) * 1000
End Sub

Dictionary

Sub Test()


    Dim rng1 As Range
    Set rng1 = Range("A1:B100000")

    Dim rng2 As Range
    Set rng2 = Range("G1:G15")

    Dim i As Long, j As Long
    Dim arr As Variant

    Dim dTime As Double
    dTime = MicroTimer

    Dim Matches As Object: Set Matches = CreateObject("Scripting.Dictionary")
    arr = rng2.Value
    'input the larger data inside a dictionary
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Not Matches.Exists(arr(i, j)) Then Matches.Add arr(i, j), 1
        Next j
    Next i

    'input the shorter data inside an array
    arr = rng1.Value
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            If Matches.Exists(arr(i, j)) Then
                'your code if the value is found
                cpt = cpt + 1
            End If
        Next j
    Next i
Debug.Print "Using Damian Method : " & cpt & " Timer : " & (MicroTimer - dTime) * 1000
End Sub