How to remove duplicate text with comma seperated

[geniusideas]

Hi,

In VBA how to remove duplicate text seperated by comma example :

Example : One Cells contained

Before - AE,AE,DE,BE,CE,CE,FE,GE,GE

After - AE,DE,BE,CE,FE,GE

Can some one give me the code.Thanks

 

[Ron Rosenfeld]

Hi,

In VBA how to remove duplicate text seperated by comma example :

Example : One Cells contained

Before - AE,AE,DE,BE,CE,CE,FE,GE,GE

After - AE,DE,BE,CE,FE,GE

Can some one give me the code.Thanks

==========================
Option Explicit
Function RemCSVDups(s As String) As String
Dim arStr As Variant
Dim sRes As String, aRes() As String
Dim col As Collection
Dim i As Long

Set col = New Collection
arStr = Split(Trim(s), ",")

On Error Resume Next
For i = 0 To UBound(arStr)
col.Add arStr(i), arStr(i)
Next i
On Error GoTo 0

ReDim aRes(0 To col.Count - 1)
For i = 0 To UBound(aRes)
aRes(i) = col(i + 1)
Next i

RemCSVDups = Join(aRes, ",")
End Function
============================
--ron

 

[Ryan H]

This should do the trick:

Sub RemoveDuplicates()

Dim aryInitial As Variant
Dim strFinal As String
Dim i As Long

aryInitial = Split(Range("A1").Value, ",")

For i = LBound(aryInitial) To UBound(aryInitial)

If InStr(strFinal, Trim(aryInitial(i))) = 0 Then
strFinal = strFinal & aryInitial(i) & ","
End If

Next i

Range("B1").Value = strFinal

End Sub

Hope this helps! If so, click "YES" below.

 

[RB Smissaert]

This will be a lot faster, but bear in mind it will alter the original
string:

Function ReplaceDupsInCSV(str As String) As String

Dim i As Long

For i = Len(str) - 1 To 1 Step -3
If InStr(1, str, Mid$(str, i, 2)) < i Then
Mid$(str, i, 2) = "--"
End If
Next i

ReplaceDupsInCSV = Replace(str, ",--", vbNullString)

End Function


You could make it a lot faster still if you use one of the Replace functions
here:
http://www.xbeat.net/vbspeed/c_Replace.htm


RBS

 

[Bernd P]

Hello,

Function NoDupe(r As Range) As Variant
Dim rC As Variant, obj As Object
Set obj = CreateObject("Scripting.Dictionary")
For Each rC In Split(r, ",", -1)
obj.Item(rC) = rC
Next rC
NoDupe = Join(obj.keys, ",")
Set obj = Nothing
End Function

Regards,
Bernd

 

[geniusideas]

Thank Guys..
It's work find.