Excel VBA: Number of matches in Lists

ouestque
ouestque used Ask the Experts™
on
Excel has data in columns A and B. Either columns can have blank and duplicates.

What is the fastest code that can find the number of unique matches between them?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You may insert a temporary sheet, copy the data from column A:B of data sheet into the Temp sheet, RemoveDuplicates on the Temp sheet on both column A and B, copy the resultant data into an array or something or do whatever you want to do with the unique data and delete the Temp sheet in the end.

Author

Commented:
Thanks Subodh, but that only finds the unique values in column A and B. I am trying to find out how many of those unique values match between A and B. Do you know the fastest way to do this?

Example:

A                  B
Hello           World
World          Teal
kkdd            YY
                    Blue
Blue
Green

In the above example, the code would say there are exactly 2 matches between column A and B. They are "World" and "Blue"
Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015
Commented:
You may try something like this...
Sub UniqueMatchingItems()
Dim ws As Worksheet
Dim x, dict, dict2
Dim i As Long

Set ws = Sheets("Sheet1")
x = ws.Range("A1").CurrentRegion.Value
Set dict = CreateObject("Scripting.Dictionary")
Set dict2 = CreateObject("Scripting.Dictionary")

For i = 2 To UBound(x, 1)
    dict.Item(x(i, 1)) = ""
Next i

For i = 2 To UBound(x, 1)
    If x(i, 2) <> "" And dict.exists(x(i, 2)) Then
        dict2.Item(x(i, 2)) = ""
    End If
Next i
If dict2.Count Then
    MsgBox Join(dict2.keys, Chr(10))
End If
End Sub

Open in new window


In the attached, click the button called "Unique Matching Items" on Sheet1 to run the code.
ouestque.xlsm

Author

Commented:
Thank you Subodh. That was some awesome code!
Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

Commented:
You're welcome!
Thanks for the feedback.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial