VBA Compare 2 arrays, write unique values to cell with comma delimiter

Question

I have a series of 2 cells in which values are separated by a comma delimiter.

Example

Cell D1 = 1,2,3,4,5,6,7,8,9,10

Cell O1 = 1,2,3,4,5,6

I want to first use the split function to pass the values to an Array and subsequently compare those 2 Arrays to find out the unique/not double values. These values then i want to write to another cell as values with a comma delimiter. Based on this answer

Comparing two Dimension array and something I found about adding values to an Array i tried my luck with this code

Sub compare() 
Dim cont As Long 
Dim x As Long 
Dim y As Long 
Dim Source As Variant 
Dim Comparison As Variant 
Dim Target As Variant

With ThisWorkbook.Worksheets("Open items")
For cont = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
Source = Split(.Range("D" & cont).Value, ",")
Comparison = Split(.Range("O" & cont).Value, ",")
For x = LBound(Source) To UBound(Source)
For y = LBound(Comparison) To UBound(Comparison)
If Source(x, y) = !Comparison(x, y) Then
Target(UBound(Target)) = Source(x, y).Value
Next
Next

Next cont
End Sub

But seem to be stuck. Is this the correct way to add a value to the Array Target? How do I get the Array into the cell?

The result in my example should be for Target to contain "7", "8", "9" , and "10" and should be shown in a cell in the way

7,8,9,10

Thank you for your help!

`These values then i want to write to another cell as values with a comma delimiter` Which cell? — Siddharth Rout, Jun 19 '17 at 13:47
Will O always contain numbers that are always in D, or will it also have unique numbers that are not in D? For example can O1 be `1,2,3,4,5,6,11`? And would the output then be `7,8,9,10,11`? — Scott Craner, Jun 19 '17 at 13:58

trincot · Accepted Answer · 2017-06-20T09:42:58.430

Some issues:

Rows.Count will look in the active sheet, not necessarily in the "Open items" sheet. So you need to add the dot: .Rows.Count
Source(x, y) will not work, since Source only has one dimension. In fact y has nothing to do with Source. A similar remark holds for Comparison.
= ! is not a valid comparison operator. You maybe intended <>.
Target is not defined, and Target(UBound(Target)) will always refer to the same location. Instead, you could append the result to a string variable immediately.

Furthermore, I would use a Collection object for fast look up, so that the algorithm is not O(n²), but O(n):

Sub Compare()
    Dim cont As Long
    Dim source As Variant
    Dim comparison As Variant
    Dim part As Variant
    Dim parts As Collection
    Dim result As String

    With ThisWorkbook.Worksheets("Open items")
        For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
            source = Split(.Range("D" & cont).Value, ",")
            comparison = Split(.Range("O" & cont).Value, ",")
            ' Add the source items in a collection for faster look-up
            Set parts = New Collection
            For Each part In source
                parts.Add Trim(part), Trim(part)
            Next
            ' Remove the comparison items from the collection
            For Each part In comparison
                On Error Resume Next ' Ignore error when part is not in parts
                    parts.Remove Trim(part)
                    If Err Then parts.Add Trim(part), Trim(part) ' Add part if not yet in parts
                On Error GoTo 0 ' Stop ignoring errors
            Next
            ' Turn the remaining collection to comma-separated string
            result = ""
            For Each part In parts
                result = result & ", " & part
            Next
            result = Mid(result, 3) ' Remove first comma and space
            ' Store the result somewhere, for example in the E column
            .Range("E" & cont).Value = result
        Next cont
    End With
End Sub

Alternative for Sorted Lists

When your source and comparison lists are sorted in numerical order, and you need the target to maintain that sort order, you could use a tandem-kind of iteration, like this:

Sub Compare()
    Dim cont As Long
    Dim source As Variant
    Dim comparison As Variant
    Dim x As Long
    Dim y As Long
    Dim result As String

    With ThisWorkbook.Worksheets("Open items")
        For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
            source = Split(.Range("D" & cont).Value, ",")
            comparison = Split(.Range("O" & cont).Value, ",")
            x = LBound(source)
            y = LBound(comparison)
            result = ""
            Do While x <= UBound(source) And y <= UBound(comparison)
                If Val(source(x)) < Val(comparison(y)) Then
                    result = result & ", " & Trim(source(x))
                    x = x + 1
                ElseIf Val(source(x)) > Val(comparison(y)) Then
                    result = result & ", " & Trim(comparison(y))
                    y = y + 1
                Else
                    x = x + 1
                    y = y + 1
                End If
            Loop
            ' Flush the remainder of either source or comparison
            Do While x <= UBound(source)
                result = result & ", " & Trim(source(x))
                x = x + 1
            Loop
            Do While y <= UBound(comparison)
                result = result & ", " & Trim(comparison(y))
                y = y + 1
            Loop
            result = Mid(result, 3) ' Remove first comma and space
            ' Store the result somewhere, for example in the E column
            .Range("E" & cont).Value = result
        Next cont
    End With
End Sub

Hi, used your code, i realized two things though: 1. If I use ur code as is, then the Debugger would tell me something is wrong when adding a part to parts. --> Removing the key solved this. --> Running the code caused the parts collection to ever increase however, so i added a Loop to clear the collection parts before it would move on to the next "cont" ` Do Until parts.Count = 0 parts.Remove 1 Loop Next cont ` 2. This caused the code to work, without the parts ever increasing but it recognized all parts as unique. --> Adding the "part" key again solved this. — JohnDoe, Jun 20 '17 at 08:16
So, can I first establish that your lists are not expected to be sorted, and that also the output does not need to be sorted? I just updated the first code block with a line to reset the `parts` collection to an empty one at the start of each iteration. — trincot, Jun 20 '17 at 08:37
However this seems to only work from times to times. In one row I have in Cell D "199, 193, 866, 987, 1006, 197, 1007, 989, 202, 175, 1031, 1032, 1030" in Cell O "987, 989, 1007" The result in cell E is "199, 193, 866, 987, 1006, 197, 202, 175, 1031, 1032, 1030,987" It seems to recognize 987 correctly. If i Change the order in Cell O to "989, 1007, 987" the result in E is "199, 193, 866, 1006, 197, 989, 202, 175, 1031, 1032, 1030,989" meaning the code has Problems recognizing the first number. Any idea why is that? — JohnDoe, Jun 20 '17 at 08:43
yes thats right. Saw your comment after I added my last comment. Any idea why the first number is not recognized correctly? — JohnDoe, Jun 20 '17 at 08:44
Yes, the reason is that contrary to what you specified in the question, you have additional spaces after the commas, which will become part of the value, and will therefor not match with a value at the start of a string that does not have that space. Either remove the spaces, or make your `Split` with an additional space (`, `), or add a space at the start of the strings... or trim the values before comparing. — trincot, Jun 20 '17 at 08:47

score 1 · Answer 2 · answered Jun 19 '17 at 15:18

Try this small UDF():

Public Function unikue(BigString As String, LittleString As String) As String
    Dim B As Variant, L As Variant, Barr, Larr
    Dim Good As Boolean

    Barr = Split(BigString, ",")
    Larr = Split(LittleString, ",")

    For Each B In Barr
        Good = True
        For Each L In Larr
            If L = B Then Good = False
        Next
        If Good Then unikue = unikue & "," & B
    Next B
    If unikue <> "" Then unikue = Mid(unikue, 2)
End Function

Thank you, gonna try it out next! – JohnDoe Jun 20 '17 at 11:22 — JohnDoe, Jun 20 '17 at 11:22

99moorem · Answer 3 · 2017-06-19T14:44:19.703

Couple of things with this code

the variable Target() - You never tell code how big this array is or if you want to make it bigger - my full code below will grow for each match that is found

Source(x, y).Value - You dont need to use Value for arrays. you also do not need x and y as you are only reading in one column you only need source(x)

Where I have wrote MISSING in the full code - these lines where missing and would have caused you issues.

The purpose of Found is that for every time source(x) is found in Comparison(y) then Found is incremented. If it has never been incremented then we can assume that it is to be captured in target.

One other note is that you do not specify where you want to output Target to. so currently the target array does not go anywhere

Sub compare()
Dim cont As Long
Dim x As Long
Dim y As Long
Dim Source As Variant
Dim Comparison As Variant
Dim Target() As Variant
ReDim Target(1)

With ThisWorkbook.Worksheets("Open items")
    For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
        Source = Split(.Range("D" & cont).Value, ",")
        Comparison = Split(.Range("O" & cont).Value, ",")
        For x = LBound(Source) To UBound(Source)
            Found = 0
            For y = LBound(Comparison) To UBound(Comparison)
                If Source(x) = Comparison(y) Then
                    Found = Found + 1
                    'count if found
                End If 'MISSING
            Next

            'if values are found dont add to target
            If Found = 0 Then
                Target(UBound(Target)) = Source(x)
                ReDim Preserve Target(UBound(Target) + 1)
            End If
        Next
    Next cont
End With 'MISSING
End Sub

VBA Compare 2 arrays, write unique values to cell with comma delimiter

3 Answers3

Alternative for Sorted Lists