' Removes duplicates within a cell from a range of
' selected cells
Sub removeDupes()
Dim x As Integer
Dim t As String, m As String
Dim c As Range, r As Range
Dim l As New Collection
Dim v As Variant
Dim b As Boolean

Set r = Selection
For Each c In r
t = c.Value
Do While Not t = ""
x = InStr(1, t, " ") ' find the first " "
' if we're not at the end of the string then
' the m is the string before the next space
' otherwise t the last word
If Not x = 0 Then
m = Mid(t, 1, x - 1)
Else
m = t
End If
If Not m = "" Then ' don't bother if m is empty
b = False
' looks to see if this word already exists
For Each v In l
If m = v Then
b = True
End If
Next v
' if it's not a duplicate then add it
If Not b Then
l.Add m
End If
End If
' remove the current word from the start of t
t = Mid(t, Len(m) + 2)
Loop
' put the non-dupe words back into the cell
c.Value = ""
For Each v In l
c.Value = c.Value & v & " "
l.Remove (1)
Next v
If Not c.Value = "" Then
c.Value = Left(c.Value, Len(c.Value) - 1)
End If
Next c

End Sub

elaine wrote:
hi,
i have got a question...
how do you delete deplicate data in the same cell?

ie. In Cell A1

apple apple apple

i wanted to delete the 2nd and 3rd apple, but keep the first apple, how
could i do that?
theres no semicolon, or any punctuation marks in between the
duplicates... just space. Can this be done?

same as if I have

apple apple banana apple

How can the 2nd apple, banana and 3rd apple be dedupe?

Thanks.
Elaine.