VBA or Formula to extract duplicate words from 2 disimilar cell strings

[BFLO2000]

I am trying to identify duplication of words between cells and am hoping this can be accomplished with VBA

Here is a sample of the input and output. I am comparing string 1 to string 2.

String 1 String 2 Output
red orange yellow green red orange yellow green blue Blue
orange yellow green blue red orange yellow green blue Red
red yellow green blue red orange yellow green blue Orange
red orange green blue red orange yellow green blue Yellow

I have used VBA to remove duplicate words in the same cell, but not in different cells.

Thanks!

 

[Fluff]

Hi & welcome to MrExcel.
Assuming the same word will not appear more than once in a cell, try

Function BFLO2000(Rng1 As Range, Rng2 As Range) As String
   Dim Sp As Variant
   Dim i As Long
   Sp = Split(Trim(Rng1))
   With CreateObject("scripting.dictionary")
      For i = 0 To UBound(Sp)
         .Item(Sp(i)) = Empty
      Next i
      Sp = Split(Trim(Rng2))
      For i = 0 To UBound(Sp)
         If .Exists(Sp(i)) Then .Remove Sp(i) Else .Item(Sp(i)) = Empty
      Next i
      BFLO2000 = Join(.Keys, ", ")
   End With
End Function

Used like =BFLO2000(A2,B2)

 

[BFLO2000]

This almost does what I need, it's removing duplicates, but it's also adding the words from the first string that aren't in the 2nd. Example is below:

String1
1781 The coast of New England

String2
Nautical Atlantic New England

Current Result
1781, The, coast, of, Nautical, Atlantic

Expected Result
Nautical, Atlantic

The words may repeat more than once, but I suppose I could do multiple iterations till I get to the uniques.

 

[Fluff]

In that case use

Function BFLO2000(Rng1 As Range, Rng2 As Range) As String
   Dim Sp As Variant
   Dim i As Long
   Sp = Split(Trim(Rng2))
   With CreateObject("scripting.dictionary")
      [COLOR=#ff0000].CompareMode = 1[/COLOR]
      For i = 0 To UBound(Sp)
         .Item(Sp(i)) = Empty
      Next i
      Sp = Split(Trim(Rng1))
      For i = 0 To UBound(Sp)
         If .Exists(Sp(i)) Then .Remove Sp(i)
      Next i
      BFLO2000 = Join(.Keys, ", ")
   End With
End Function

If you want it case sensitive remove the line in red.

 

[BFLO2000]

Excellent Solution! Thank you for the quick response.

 

[Fluff]

You're welcome & thanks for the feedback