Compare two arrays to find the difference

[Vincent88]

Hi Guys,
I use this code to find the difference and create a new array to list in column P. It's stuck. Please help.

Sub test7()
Dim ws As Worksheet
Set ws = Worksheets("Data")
Dim v1 As Variant, v2 As Variant, v3 As Variant
Dim coll As Collection
Dim i As Long

'Assumes 0-based Variants
v1 = ws.Range("N1", ws.Range("N1").End(xlDown))
v2 = ws.Range("O1", ws.Range("O1").End(xlDown))

ReDim v3(LBound(v1) To Abs(UBound(v2) - UBound(v1)) - 1)

Set coll = New Collection
For i = LBound(v1) To UBound(v1)
    coll.Add v1(i), v1(i)
Next i
For i = LBound(v2) To UBound(v2)
    On Error Resume Next
    coll.Add v2(i), v2(i)
    If Err.Number <> 0 Then
        coll.Remove v2(i)
    End If
    On Error GoTo 0
Next i
For i = LBound(v3) To UBound(v3)
    v3(i) = coll(i + 1) 'Collections are 1-based
    Debug.Print v3(i)
Next i
End Sub

TestDropDownList_2.xlsm
	N	O	P
1	Agent	From ColumnA	Find Missing bet N & O
2	Cat G	Cat G
3	Jack S	Ken C
4	John G	Larry Q
5	Ken C	Mandy H
6	Larry Q	Mary K
7	Mandy H	Nancy L
8	Mary K	Peter B
9	Nacy L	Robert M
10	Peter B	Viola C
11	Robert M	Warus O
12	Viola C	Zita V
13	Warus O
14	Zita V
Data

 

[Marc L]

Hi,​

​

What is the expected result ?‼​

 

[Fluff]

As v1 is a 2d array & not a 1d array it should be

coll.Add v1(i, 1), v1(i, 1)

 

[Marc L]

According to Excel basics a VBA demonstration without any useless loop :​

Sub Demo1()
  Const F = "TRANSPOSE(IF(ISNA(MATCH(N2:N#,O2:O¤,0)),N2:N#,FALSE))"
    Dim V
    With Sheets("Data")
        V = .Cells(.Rows.Count, 16).End(xlUp).Row:  If V > 1 Then .Range("P2:P" & V).Clear
        V = Filter(.Evaluate(Replace(Replace(F, "#", .[N1].End(xlDown).Row), "¤", .[O1].End(xlDown).Row)), False, False)
        If UBound(V) > -1 Then .[P2].Resize(UBound(V) + 1).Value2 = Application.Transpose(V)
    End With
End Sub

 

[Marc L]

The constant formula in previous post can be reduced as "TRANSPOSE(IF(ISNA(MATCH(N2:N#,O2:O¤,0)),N2:N#))" …​

​

 

[Vincent88]

Hi,​

​

What is the expected result ?‼​

Hi Marc L,
The expect result (to display in column P) is to find those names, when comparing to column N, which do not appear in column O.

 

[Marc L]

​

So this is what already achieves my post #4 demonstration …​

 

[Vincent88]

Hi Marc L,
Your code works. Thank you.
In fact those values in column N and O are extracted from two arrays (see my codes). How to find the differences between these two arrays directly without putting then into columns (Leave Column N and O blank, just show the result in Column P).

'In Sheet("Data')

Private Sub Worksheet_Change(ByVal Target As Range)
   'Sort Agent Name by alphabetic order
    Dim lr As Long
    Dim Agtarray As Object
    Dim cl As Range
    Dim Sorted_array As Variant
    
    'Creating a array list
    Set Agtarray = CreateObject("System.Collections.ArrayList")
    
    'Physical Source in Column L
    lr = Range("L1").End(xlDown).Row
    Debug.Print lr

    For Each cl In Range("L1:L" & lr)
        If Not Agtarray.contains(cl.Value) Then Agtarray.Add cl.Value
    Next cl
      
    Agtarray.Sort
    Sorted_array = Agtarray.toarray
          
    Range("N1").Resize(UBound(Sorted_array) + 1, 1).Value = Application.Transpose(Sorted_array)
 
End Sub


'In ActiveSheet

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Sh.Name = "Data" Then Exit Sub
If Target.CountLarge > 1 Or Target.Columns > 1 Then Exit Sub Then Exit Sub

'DropDownList in Column A
Dim lrA As Long
Dim colAarray As Object
Dim rngA As Range
Dim clA As Range
Dim SortedColA_array As Variant

'Creating a array list
Set colAarray = CreateObject("System.Collections.ArrayList")

'Physical Source in Column L
lrA = Range("A1").End(xlDown).Row
Debug.Print lrA
Set rngA = Range("A3:A" & lrA)


   For Each clA In rngA
      If Not colAarray.contains(clA.Value) Then colAarray.Add clA.Value
   Next clA
 
colAarray.Sort
SortedColA_array = colAarray.toarray

'Output SortedColA_array to Cells
Sheets("Data").Range("O2").Resize(UBound(SortedColA_array) + 1, 1).Value = Application.Transpose(SortedColA_array)

End Sub

 

[cmowla]

According to Excel basics a VBA demonstration without any useless loop :​

Sub Demo1()
  Const F = "TRANSPOSE(IF(ISNA(MATCH(N2:N#,O2:O¤,0)),N2:N#,FALSE))"
    Dim V
    With Sheets("Data")
        V = .Cells(.Rows.Count, 16).End(xlUp).Row:  If V > 1 Then .Range("P2:P" & V).Clear
        V = Filter(.Evaluate(Replace(Replace(F, "#", .[N1].End(xlDown).Row), "¤", .[O1].End(xlDown).Row)), False, False)
        If UBound(V) > -1 Then .[P2].Resize(UBound(V) + 1).Value2 = Application.Transpose(V)
    End With
End Sub

Very cool code. I had the fundamentals of how the majority of this works already down, but today I learned that .Evaluate() creates an array when the result in the spreadsheet is an array. (So Sheet.Evaluate must be of type variant. Makes sense!)

However, the code is still incomplete with regards to output. It only shows what column O has that column P doesn't (and not vice versa).

I rewrote this code in the style of coding that I like, made it into an function (you have to pass arguments but don't have to manually change them in the code itself of use a specific part of a specific sheet to input the column data), and have it show a Union of what one column has that another does not.

And I also posted this so that future viewers can directly test this algorithm ^^ with the example spreadsheet in the first post.

Sub Test__Diff_BTW_Data_In_This_Col_And_This_Col()
Call MA(Diff_BTW_Data_In_This_Col_And_This_Col(ActiveSheet.Name, "A", "B", "C", 2))
End Sub
Function Diff_BTW_Data_In_This_Col_And_This_Col( _
sheetName As String, _
column1Letter As String, _
column2Letter As String, _
outputColumnLetter As String, _
startRow As Long _
)

With Sheets(sheetName)

    Dim lastRowInColumn1 As Long 'Left column
    lastRowInColumn1 = .Range(column1Letter & startRow).End(xlDown).Row
   
    Dim column1Range As String
    column1Range = column1Letter & startRow & ":" & column1Letter & lastRowInColumn1

    Dim lastRowInColumn2 As Long 'Right column
    lastRowInColumn2 = .Range(column2Letter & startRow).End(xlDown).Row

    Dim column2Range As String
    column2Range = column2Letter & startRow & ":" & column2Letter & lastRowInColumn2

    Dim lastRowInOutputColumn As Long
    lastRowInOutputColumn = .Range(column2Letter & startRow).End(xlDown).Row

    'If there are any entries in the output column, clear them.
    If lastRowInOutputColumn > startRow Then .Range(outputColumnLetter & startRow & ":" & outputColumnLetter & lastRowInOutputColumn).Value = ""

    Dim elements_In_Col1_But_Not_In_Col2() As Variant
    elements_In_Col1_But_Not_In_Col2 = .Evaluate("TRANSPOSE(IF(ISNA(MATCH(" & column1Range & "," & column2Range & ",0))," & column1Range & ",FALSE))")

    Dim elements_In_Col2_But_Not_In_Col1() As Variant
    elements_In_Col2_But_Not_In_Col1 = .Evaluate("TRANSPOSE(IF(ISNA(MATCH(" & column2Range & "," & column1Range & ",0))," & column2Range & ",FALSE))")

    Dim elementsNotShared() As String
    elementsNotShared = Filter(Split(Join(elements_In_Col1_But_Not_In_Col2, ",") & "," & Join(elements_In_Col2_But_Not_In_Col1, ","), ","), False, False)

    If UBound(elementsNotShared) >= 0 Then
        .Range(outputColumnLetter & startRow & ":" & outputColumnLetter & UBound(elementsNotShared) + startRow).Value = Application.Transpose(elementsNotShared)
        Diff_BTW_Data_In_This_Col_And_This_Col = elementsNotShared
    End If

End With

End Function


Sub MA(args As Variant)

On Error Resume Next 'In case the array to be displayed doesn't have a 0th argument.
Dim i As Integer
i = 0
Do While i <= UBound(args) - LBound(args) + 1
    Debug.Print (i)
    MsgBox args(i)
    i = i + 1
Loop
End 'Quit execution of all subs.
End Sub

 

[Marc L]

(and not vice versa).

Which is not requested according to post #6 !​