vba - remove duplicates in a text string

[monsierexcel]

i have a string that has produced duplicate words

AC2 >"test grey grey white black white" what i want to produce> "test grey white black"
AC3> "blue green green black white black" what i want to produce> "blue green black white"

is there a way in VBA to remove duplicate words out of a string and present in the info as a formula for each row?
i have seen a function available to handle this but not sure how i present these functions for each row?

thank you guys

 

[KennyGreens]

Hi, what do you mean by present as a formula for each row?

 

[njimack]

I'm sure there's a more efficient method, but this should work...

Function Remove_Duplicate(cell As Range)

Dim str
Dim i As Long
str = Split(cell, " ")
For i = 0 To UBound(str)
    If InStr(1, Remove_Duplicate, str(i), 1) = 0 Then Remove_Duplicate = Remove_Duplicate & " " & str(i)
Next i
Remove_Duplicate = Trim(Remove_Duplicate)
End Function

 

[monsierexcel]

thanks neil how do i get this function to run in a specific range?

 

[njimack]

You referred to a formula so I assumed you wanted a function. You would enter:
=Remove_Duplicate(AC2)

 

[Rick Rothstein]

I'm sure there's a more efficient method, but this should work...

Function Remove_Duplicate(cell As Range)

Dim str
Dim i As Long
str = Split(cell, " ")
For i = 0 To UBound(str)
    If InStr(1, Remove_Duplicate, str(i), 1) = 0 Then Remove_Duplicate = Remove_Duplicate & " " & str(i)
Next i
Remove_Duplicate = Trim(Remove_Duplicate)
End Function

The following code may be more efficient (I think dictionaries are more efficient than repeated concatenations), however I do not think any speed difference that may exist will be noticed for what I assume are somewhat short text strings.

Function Uniques(Text As String) As String
  Dim X As Long, Data() As String
  Data = Split(Text)
  With CreateObject("Scripting.Dictionary")
    For X = 0 To UBound(Data)
      .Item(Data(X)) = 1
    Next
    Uniques = Join(.keys)
  End With
End Function

 

[Tom.Jones]

@Rick, @njimack

The difference (I can see) between VBA codes is that njimack's code is not case sensitive, and Rick's, case sensitive.

 

[Fluff]

If the Op wants something that is case insensitive, this mod to Rick's code will do that.

Function Uniques(Text As String) As String
  Dim X As Long, Data() As String
  Data = Split(Text)
  With CreateObject("Scripting.Dictionary")
    [COLOR=#0000ff].CompareMode=1[/COLOR]
    For X = 0 To UBound(Data)
      .Item(Data(X)) = 1
    Next
    Uniques = Join(.keys)
  End With
End Function

 

[monsierexcel]

thank you guys, this is brilliant.

 

[dma431]

Hi,
Can Rick's code be adapted to extract the duplicate instead?