Duplicate Values in Cell

[Karl]

I have 10,000 rows of data. I need to delete duplicate values with in a cell
and keep the unique values in the cell.

Here is what I have:

Make Model Color
Dodge Charger Red, Green, Yellow, Red, Green, Yellow

I want to get to:

Make Model Color
Dodge Charger Red, Green, Yellow


Please let me know if you have any suggestions

 

[Stefan Hoffmann]

hi Karl,

I have 10,000 rows of data. I need to delete duplicate values with in a cell
and keep the unique values in the cell.

Here is what I have:

Make Model Color
Dodge Charger Red, Green, Yellow, Red, Green, Yellow

I want to get to:

Make Model Color
Dodge Charger Red, Green, Yellow


Please let me know if you have any suggestions

You should normalize your table. Otherwise you may use Split() and loop
over the result array like this (untested):


Public Function RemoveMultipleTokens(AString As String) As String

Dim a() As String
Dim b() As Boolean
Dim i As Long
Dim j As Long
Dim u As Long
Dim r As String

a() = Split(AString, ",")
u = UBound(a)
ReDim b(0 To u)

For i = 0 To u
For j = 0 To u
b(i) = (a(i) = a(j))
Next j, i

For i = 0 To u
If b(i) Then
r = r & a(i) & ", "
End If
Next i

RemoveMultipleTokens = Left(r, Len(r) - 2)

End Function


mfG
--> stefan <--

 

[Dale Fye]

Is this in Excel, or in Access?

If in Access, why don't you take advantage of the relational aspect of
Access and create a separate table to store the car colors. The first rule
of data normalization says something like "each field should hold no more
than one piece of data".

The first thing I would do is add a ModelID (autonumber) to the table that
currently holds your Make and Model. Then I would create the table of car
colors, so what you would have is:

tblCars:
ModelID Make Model
1 Dodge Charger
2 Chrysler 300C

tbl_CarColors
CarColorID ModelID Color
1 1 Red
2 1 Green
3 1 Yellow
4 2 Blue

With this structure, you can query your database with much simplier and far
quicker results to show you all of the models that come in "Yellow" or which
come in more than 3 colors, or whatever.

 

[John Spencer MVP]

Steven,

My test of that code returns other than the desired results.

RemoveMultipleTokens ("A,A,B,C,D,B,C,D") returns D, D

I think the poster wanted to see A, B, C, D returned

I think this minor revision of your code will work. Although, it may not
return the items in the order the poster wants.

Public Function RemoveMultipleTokens(AString As String) As String
'Now it works
Dim a() As String
Dim b() As Boolean
Dim i As Long
Dim j As Long
Dim u As Long
Dim r As String

a() = Split(AString, ",")
u = UBound(a)
ReDim b(0 To u)

For i = 0 To u
For j = i + 1 To u
If Trim(a(i)) = Trim(a(j)) Then
b(i) = True
Exit For
End If
Next j
Next i

For i = 0 To u
If b(i) = False Then
r = r & a(i) & ", "
End If
Next i

RemoveMultipleTokens = Trim(Left(r, Len(r) - 2))

End Function

John Spencer
Access MVP 2002-2005, 2007-2009
The Hilltop Institute
University of Maryland Baltimore County

 

[Karl]

This is an excel file I was given by my boss. I have loaded it into Access. I
wanted to see if there was away to eliminate the duplicate values, without
having to go into each record.

Karl

 

[Stefan Hoffmann]

hi John,

My test of that code returns other than the desired results.

Therefore "untested" as I've just typed it straight down to show to
general direction.

This is what I would use for real:

Option Compare Database
Option Explicit

Public Function RemoveDuplicateTokens(AString As String) As String

Dim a() As String
Dim b() As Boolean
Dim i As Long
Dim j As Long
Dim u As Long
Dim r As String

a() = Split(AString, ",")
u = UBound(a)
ReDim b(0 To u)

For i = 0 To u
For j = i + 1 To u
If Trim(a(i)) = Trim(a(j)) Then
b(j) = True
Exit For
End If
Next j
Next i

For i = 0 To u
If Not b(i) Then
r = r & a(i) & ", "
End If
Next i

RemoveDuplicateTokens = Left(r, Len(r) - 2)

End Function

Public Function RemoveMultipleTokens(AString As String) As String

Dim a() As String
Dim b() As Long
Dim i As Long
Dim j As Long
Dim u As Long
Dim r As String

a() = Split(AString, ",")
u = UBound(a)
ReDim b(0 To u)

For i = 0 To u
For j = 0 To u
b(i) = b(i) + Abs((Trim(a(i)) = Trim(a(j))))
Next j, i

For i = 0 To u
If b(i) = 1 Then
r = r & a(i) & ", "
End If
Next i

RemoveMultipleTokens = Left(r, Len(r) - 2)

End Function




mfG
--> stefan <--