'Matching arrays with identical unique values VBA (Excel)

I have been trying to figure this out for some time now. Originally I had searched Google and found some examples of (more or less) what I am trying to do, but seem to be stuck on the code I have thus far. Essentially I am trying to compare the unique variables between two arrays and return a result when there is a perfect match (if one possesses unique values there represent a subset of the other, this would not be a perfect match, all values and number of values would have to be identical.

From the code I have included below; if I compare one array [range("B2:b6") with values {1, 2, 3}] to a second array [(range("D10:D11") with values {1, 2}], I receive a positive match. Per what I am trying to do however (and value order doesn't matter) the only perfect match within an array of {1, 2, 3} would be a second array with values {1, 2, 3} also (or {3, 2, 1} as order doesn't matter).

I am guessing it is due to the type of array I am using and the fact that the lowerbound starts at 0. I could also be completely wrong. I have tried playing around with it without success.

Any Thoughts? Any suggestions are welcome. Thanks! (included pics with different values below)

enter image description here

Function UniqueVal(ByRef Arr1, ByRef Arr2)

    If TypeOf Arr1 Is Range Then Arr1 = Arr1.Value2
    If TypeOf Arr2 Is Range Then Arr2 = Arr2.Value2

    Dim e, x, i As Long

     With CreateObject("scripting.dictionary")
        .CompareMode = 1
        For Each e In Arr1
            If Len(e) Then .Item(e) = Empty
        Next
        For Each e In Arr2
            If .Exists(e) Then
                .Item(e) = 1
            Else
                .RemoveAll
                UniqueVal = .Keys
                Exit Function
            End If
        Next

        x = Array(.Keys, .Items)
        .RemoveAll
        For i = 0 To UBound(x(0))
            If x(1)(i) = 1 Then .Item(x(0)(i)) = Empty
        Next
        If .Count Then UniqueVal = .Keys
    End With

End Function

'and the below sub which calls the above function

Sub iTestIntersectionX()

array4 = Join(UniqueVal(Worksheets("arrayTest2").Range("B2:B6"), Worksheets("arrayTest2").Range("D10:D11")), vbLf)
Worksheets("arrayTest2").Range("H20").value = array4

If Worksheets("arrayTest2").Range("H20").value <> "" Then
   MsgBox "Match Found!"
  Else
   MsgBox "No Match Found!"
End If

End Sub


Solution 1:[1]

This will return True if the two ranges passed in have the same set of unique values (in any order or frequency)

Function HaveSameValues(rng1 As Range, rng2 As Range)
Dim c As Range

    For Each c In rng1.Cells
        If Len(c.Value) > 0 And IsError(Application.Match(c.Value, rng2, 0)) Then
            SameValues = False
            Exit Function
        End If
    Next c
    For Each c In rng2.Cells
        If Len(c.Value) > 0 And IsError(Application.Match(c.Value, rng1, 0)) Then
            SameValues = False
            Exit Function
        End If
    Next c

    SameValues = True

End Function

Solution 2:[2]

enter image description here

When a range is a continuous column, the question can be solved with this formula:

LET(Target;B2:B6;Reference;D10:D11;AND(IFNA(SORT(UNIQUE(FILTER(Target;Target<>"")))=SORT(UNIQUE(FILTER(Reference;Reference<>"")));FALSE)))

If the range is different than a 1-dimensional array, I would use this code:

Function HaveSameUniques(Target As Range, Reference As Range) As Boolean
Dim TargetUniques As New Collection
Dim ReferenceUniques As New Collection
Dim Cell As Range
    HaveSameUniques = False     ' return False by default; we can drop this line
    On Error Resume Next
    For Each Cell In Target
        If Len(Cell) <> 0 Then
            TargetUniques.Add Key:=Cell.Value, Item:=0
        End If
    Next Cell
    For Each Cell In Reference
        If Len(Cell) <> 0 Then
            On Error Resume Next
            TargetUniques.Add Key:=Cell.Value, Item:=0
            If Err.Number = 0 Then Exit Function    ' if Target doesn't have Cell.Value, then exit and return false
            ReferenceUniques.Add Key:=Cell.Value, Item:=0
        End If
    Next Cell
    If TargetUniques.Count = ReferenceUniques.Count then
        HaveSameUniques = True
    End If
End Function

Solution 3:[3]

There's a formula you can enter into a cell called VLOOKUP. It takes several parameters. It looks up the value of one cell in a list of cells and returns the value of the cell next to the matching cell in the list of cells.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Tim Williams
Solution 2 Vitalizzare
Solution 3 Russell Harkins