VBA Function to compare strings in two cells and only show unique values

[dasaaa]

Dear All,

I am willing to compare two cells according to first one and only show changed values;

in example,
A1 cell contains a string as: AB, BA, BC, DC, GF, YZ
B1 cell contains a string as: AA, DC, BC, BA, GH, JK

I am willing to get AA, GH, JK

Thanks for any help!

 

[RickXL]

Hi,

I am not quite sure how you want the result presented. This one displays the answer in the Immediate Window in the VB Editor. Ctrl + G is the shortcut to open the window.

I have assumed that you are using Windows.

Sub compare()
    Dim a1      As Variant
    Dim b1      As Variant
    Dim v       As Variant
    Dim dic     As Object
    
    Set dic = CreateObject("Scripting.Dictionary")
    a1 = Split(Range("A1"), ", ")
    b1 = Split(Range("B1"), ", ")
    
    For Each v In a1
        dic(v) = 1
    Next

    For Each v In b1
        dic(v) = dic(v) + 2
    Next
    
    For Each v In dic
        If dic(v) = 2 Then Debug.Print v; dic(v)
    Next
End Sub

Cell A1 is read into an array that is made by splitting the contents using comma and space as a delimiter.

The Dictionary then assigns an Item number of 1 to all the items in the first string.
It then adds 2 for each item in the second string. So strings in both cells will have an item of 3 (i.e. 2 + 1).

The ones you are interested in will all have items of 2.
Those are displayed in the last loop.


Regards,

 

[dasaaa]

Thank you!! I am trying right away!

Is it possible to use this as a function in a cell; like =compare(a1,b1)
I have a 14,000 rows so it would be much better to use it in formula.

 

[MickG]

Perhaps this UDF:-
Where R1 = "A1" and R2 = "B1"

Function Dups(R1 As String, R2 As String) As String
Dim nstr As String, R As Variant
    For Each R In Split(R2, ", ")
        If InStr(R1, Trim(R)) = 0 Then
            nstr = nstr & IIf(nstr = "", R, ", " & R)
        End If
    Next R
Dups = nstr
End Function

 

[Rick Rothstein]

Here is a UDF that I think should work...

Function NotThere(BaseText As String, TestText As String) As String
  Dim V As Variant, BaseWords() As String
  NotThere = ", " & TestText & ", "
  For Each V In Split(BaseText, ", ")
    NotThere = Replace(NotThere, ", " & V & ", ", ", ")
  Next
  NotThere = Mid(Application.Trim(NotThere), 3, Len(NotThere) - 4)
End Function

 

[dasaaa]

Rick and Mick.. It works like charm! Is there any way I can buy you guys a beer! Dude, this will save me a huge amount of time today!

 

[Rick Rothstein]

Perhaps this UDF:-
Where R1 = "A1" and R2 = "B1"

Function Dups(R1 As String, R2 As String) As String
Dim nstr As String, R As Variant
    For Each R In Split(R2, ", ")
        If InStr(R1, Trim(R)) = 0 Then
            nstr = nstr & IIf(nstr = "", R, ", " & R)
        End If
    Next R
Dups = nstr
End Function

I am not sure if the OP's data is exactly as he showed us (2-character "words"), but if it isn't, there may be a potential problem with your UDF as written. If the value in cell A1 contains a "word" that, in turn, contains one of the "words" from cell B1, the "word" from cell B1 will be misidentified as duplicate. For example, if these values are in the indicated cells...

A1: AB, BA, XBCX, DC, GF, YZ
B1: AA, DC, BC, BA, GH, JK

The red BC in cell B1 is contained within the blue XBCX in cell A1... your code will assume they are duplicates and not report BC in its output.

 

[MickG]

You are obviously right Rick, but you could spend a lot of time trying to cover all the eventualities.!!!