'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)
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]
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 |


