delete duplicate data in the same cell

[elaine]

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.

 

[Jim Cone]

Elaine,
Do you want to just keep the first word in a cell or
to eliminate duplicates of the first word or
eliminate all duplicate words in the cell?
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


"elaine" <[email protected]>
wrote in message
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.

 

[Jason Lepack]

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 it's the
If Not x = 0 Then
m = Mid(t, 1, x - 1)
Else
m = t
End If
If Not m = "" Then
b = False
For Each v In l
If m = v Then
b = True
End If
Next v
If Not b Then l.Add m
End If
t = Mid(t, Len(m) + 2)
Loop
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

 

[Jason Lepack]

' 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]

thanks jason, it works perfectly!

' 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]

hi john,
the funtion doesnt work if it is :

apple apple banana apple banana

in the cell...
it will just return "apple" instead of "apple banana"

Thanks for you help anyway!

elaine.

 

[elaine]

hi John Bundy...
Text to column will be too time consuming after spliting each word onto
a different column if there are like 100s words on each row and there
are 100s of rows...?

Will it be a mission to filter then??

Is there a way to filter the row btw??

elaine.