Create a Unique list of names from 2 given ranges

Question

I have this set of code that is not running correctly.

It takes a list of names from Sheets("one") and Sheets("two") and is supposed to find unique names and put them on Sheets("three").

• Both lists are just strings of text.
• Both lists are not sequential, meaning that one name maybe in different row from the other range. It is in no particular order.

By the looks of it, it's just taking one range in full and making that the output, no names are being filtered out.

For this example, I have 150 names on sheet "one", and 160 names are on sheet "two". I should only be seeing about 10 unique values on sheet "three". But instead I am getting a return value of exactly 160.

Any Ideas?

Sub dupes()

Dim arrRanges(1) As Excel.Range
Dim dDedupe As New Scripting.Dictionary
Dim lngCounter As Long
Dim rngInspect As Excel.Range

Set arrRanges(0) = Sheets("one").Range("A2:A1000")
Set arrRanges(1) = Sheets("two").Range("A2:A1000")

For lngCounter = 0 To 1

    For Each rngInspect In arrRanges(lngCounter).cells
        If Not dDedupe.Exists(CStr(rngInspect.Value)) Then
            dDedupe.Add CStr(rngInspect.Value), dDedupe.count
        End If
    Next rngInspect

Next lngCounter

'Output
Sheets("three").Range("A2").Resize(dDedupe.count).Value = Application.Transpose(dDedupe.Keys())

End Sub

Answer 1

From the way the question is worded, I assume you are looking to extract only names, that occur once in your data (which is why comparing lists of 150 and 160 names should only output the 10 names, that occur only once).

Your code in itself is fine, but nowhere in your code do you actually handle/ remove the duplicates, try this adjusted code:

Sub dupes()

Dim arrRanges(1) As Excel.Range
Dim dDedupe As New Scripting.Dictionary
Dim lngCounter As Long
Dim rngInspect As Excel.Range
Dim strKey As String

Set arrRanges(0) = Sheets("one").Range("A2:A" & Sheets("one").Cells(Rows.Count, 1).End(xlUp).Row)
Set arrRanges(1) = Sheets("two").Range("A2:A" & Sheets("two").Cells(Rows.Count, 1).End(xlUp).Row)

For lngCounter = 0 To 1

    For Each rngInspect In arrRanges(lngCounter).Cells
        strKey = CStr(rngInspect.Value)
        If dDedupe.Exists(strKey) Then
            dDedupe(strKey) = dDedupe(strKey) + 1
        Else
            dDedupe.Add strKey, 1
        End If
    Next rngInspect

Next lngCounter

For Each Key In dDedupe.Keys()
    If dDedupe(Key) > 1 Then dDedupe.Remove Key
Next Key
'Output
Sheets("three").Range("A2").Resize(dDedupe.Count).Value = Application.Transpose(dDedupe.Keys())

End Sub

This sub will count the occurences of each name, and then remove all names that occur more than once.

A more efficient way to do this would be to store all the names in an array (instead of storing the two different ranges in an array) and looping through that array instead of accessing each cell one by one.