List Unique/Common Values From Two Ranges

**Admin** · 09-16-2011, 08:34 AM

Hi All,

Here is a UDF, which gives you either UNIQUE values or COMMON values from TWO ranges based on the 'StrType' parameter.

Paste the code in a Standard module.

Code:

'// Developed by Kris @ ExcelFox.com on 15-Sep-2011

Public dicU    As Object
Public dicC    As Object
Function GETVALUES(ByRef V1, ByRef V2, Optional ByVal StrType As Long = 0, _
                            Optional ByVal Delim As String = ", ") As String
    
    Dim r       As Long
    Dim c       As Long
    Dim d       As Object
    
    '//StrType = 0 (For Unique Values)
    '//StrType = 1 or any non zero number (For Common Values)
    
    If TypeOf V1 Is Range Then V1 = V1.Value
    If TypeOf V2 Is Range Then V2 = V2.Value
    
    If dicC Is Nothing Then
        Set dicC = CreateObject("scripting.dictionary")
            dicC.comparemode = 1
    End If
    If dicU Is Nothing Then
        Set dicU = CreateObject("scripting.dictionary")
            dicU.comparemode = 1
    End If
    
    If IsArray(V1) Then
        For r = 1 To UBound(V1, 1)
            For c = 1 To UBound(V1, 2)
                If Not dicU.exists(Trim$(V1(r, c))) Then
                    dicU.Add Trim$(V1(r, c)), 1
                End If
            Next
        Next
    Else
        dicU.Add Trim$(V1), 1
    End If
    If IsArray(V2) Then
        For r = 1 To UBound(V2, 1)
            For c = 1 To UBound(V2, 2)
                If StrType = 0 Then
                    If Not dicU.exists(Trim$(V2(r, c))) Then
                        dicU.Add Trim$(V2(r, c)), 2
                    End If
                Else
                    If dicU.exists(Trim$(V2(r, c))) Then
                        If dicU.Item(Trim$(V2(r, c))) = 1 Then
                            dicC.Item(Trim$(V2(r, c))) = Empty
                        End If
                    End If
                End If
            Next
        Next
    Else
        If StrType = 0 Then
            If Not dicU.exists(Trim$(V2)) Then
                dicU.Add Trim$(V2), 2
            End If
        Else
            If dicU.Item(Trim$(V2)) = 1 Then
                dicC.Item(Trim$(V2)) = Empty
            End If
        End If
    End If
    
    If StrType = 0 Then
        If dicU.Count Then GETVALUES = Join$(dicU.keys, Delim)
    Else
        If dicC.Count Then GETVALUES = Join$(dicC.keys, Delim)
    End If
        
End Function

Here is an example..

Sheet1