Excel VBA: Number of matches in Lists

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?
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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.
ouestqueAuthor 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?


A                  B
Hello           World
World          Teal
kkdd            YY

In the above example, the code would say there are exactly 2 matches between column A and B. They are "World" and "Blue"
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ouestqueAuthor Commented:
Thank you Subodh. That was some awesome code!
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome!
Thanks for the feedback.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.