Compare two cells with Text strings separated by comma; return Unique & Duplicate values

[pvkvimalan]

Hi,

I have vast data flowing from Primavera P6. There are numerous Activity IDs' that has to be compared between two schedules. Each cell has several text strings (Activity ID) that are separated by a comma (,). I have recreated the scenario in the below table and require 3 different results as in the table. A simple substitute function is able to produce accurate results. I did try some VBA's but the results were partial. I need some expert advice to help solving the problem.

Thanks in advance

 

[Paul Ked]

Try this:

Sub GetSplits()
    '
    'Activity id strings in A2 & B2
    '
    Dim arr1, arr2, i&, j&, c&, strA$, strB$, strC$
    arr1 = Split(Cells(2, 1), ",")
    arr2 = Split(Cells(2, 2), ",")
    For i = 0 To UBound(arr1)
        For j = 0 To UBound(arr2)
            If arr1(i) = arr2(j) Then
                strC = strC & "," & arr1(i)
                c = 1
            End If
        Next
        If c = 0 Then strA = strA & "," & arr1(i)
        c = 0
    Next
    For i = 0 To UBound(arr2)
        For j = 0 To UBound(arr1)
            If arr2(i) = arr1(j) Then c = 1
        Next
        If c = 0 Then strB = strB & "," & arr2(i)
        c = 0
    Next
    If strA <> "" Then strA = Right(strA, Len(strA) - 1)
    If strB <> "" Then strB = Right(strB, Len(strB) - 1)
    If strC <> "" Then strC = Right(strC, Len(strC) - 1)
    MsgBox "Unique in A2 - " & strA & vbCr _
        & "Unique in B2 - " & strB & vbCr _
        & "Duplicates in A2 & B2 - " & strC
End Sub

 

[Paul Ked]

Link to workbook

 

[Yongle]

or ... similar to @Paul Ked solution but as a function ...

Use as a formula in cell

Call from a procedure

Sub CallFunction()
    Dim s As String, X As String, Y As String
    X = Range("A2")
    Y = Range("B2")
   
    MsgBox UniqDup(X, Y, 1), , "Unique 1st range"
    MsgBox UniqDup(X, Y, 2), , "Unique 2nd range"
    MsgBox UniqDup(X, Y, 0), , "In both"
'also works
    MsgBox UniqDup(X, Y), , "In both"
End Sub

The function

Function UniqDup(ONE As String, TWO As String, Optional attr As Integer) As Variant
    Dim aArr, bArr, A As Long, B As Long, D As String, aU As String, bU As String
    On Error Resume Next
    D = ";": aU = D: bU = D
    aArr = Split(ONE, ",")
    bArr = Split(TWO, ",")
'get unique in A and duplicates
    For A = 0 To UBound(aArr)
        For B = 0 To UBound(bArr)
            If aArr(A) = bArr(B) Then
                D = D & "," & aArr(A)
                Exit For
            Else
                If B = UBound(bArr) Then aU = aU & "," & aArr(A)
            End If
        Next B
    Next A
    aU = Replace(aU, ";,", ";")
    D = Replace(D, ";,", "")
'get unique in B
    For B = 0 To UBound(bArr)
        For A = 0 To UBound(aArr)
            If aArr(A) = bArr(B) Then
                Exit For
            Else
                If A = UBound(aArr) Then bU = bU & "," & bArr(B)
            End If
        Next A
    Next B
    bU = Replace(bU, ";,", ";")
 
    UniqDup = Split(D & aU & bU, ";")(attr)
End Function

 

[Paul Ked]

It's either 'Great minds think alike' or 'Fools seldom differ'

 

[pvkvimalan]

@Paul Ked & @Yongle I thank both for a swift response. I shall try them and post my comment.

 

[pvkvimalan]

@Paul Ked The macro works like a charm, but it works only for two cells A2 $ B2, whereas I have rows of data up to 4900. it would be of great help if you could go through the attached sample file with real data along with the desired result and give me a VBA as a function.

Sample data with desired results

 

[pvkvimalan]

@Yongle Thanks I checked with your function. It works perfectly.

 

[Yongle]

Thanks for the feedback but ... I forgot to test for an empty string in either value
Amended function is below and it includes 2 extra lines to handle that scenario

Function UniqDup(ONE As String, TWO As String, Optional attr As Integer) As Variant
    Dim aArr, bArr, A As Long, B As Long, D As String, aU As String, bU As String
    On Error Resume Next
    D = ";": aU = D: bU = D
    aArr = Split(ONE, ",")
    bArr = Split(TWO, ",")
'get unique in A and duplicates
    For A = 0 To UBound(aArr)
        For B = 0 To UBound(bArr)
            If aArr(A) = bArr(B) Then
                D = D & "," & aArr(A)
                Exit For
            Else
                If B = UBound(bArr) Then aU = aU & "," & aArr(A)
            End If
        Next B
    Next A
    D = Replace(D, ";,", "")
    aU = Replace(aU, ";,", ";")
   
'get unique in B
    For B = 0 To UBound(bArr)
        For A = 0 To UBound(aArr)
            If aArr(A) = bArr(B) Then
                Exit For
            Else
                If A = UBound(aArr) Then bU = bU & "," & bArr(B)
            End If
        Next A
    Next B
    bU = Replace(bU, ";,", ";")
'deal with empty strings
    If ONE = "" Then aU = ";": bU = ";" & TWO: D = ""
    If TWO = "" Then bU = ";": aU = ";" & ONE: D = ""
   
    UniqDup = Split(D & aU & bU, ";")(attr)
End Function

 

[Paul Ked]

it would be of great help if you could go through the attached sample file with real data along with the desired result and give me a VBA as a function.

Love to, but I'm here to help you along not do everything for you . Time is precious and you've got Yongle's function... it's not identical to my method, but they could be twins!