How to remove duplication in text string?
 

Hi,

I have text string with Comma separated for example:
AAAA,CCCC,BBBBBB,CCCC,DDDD,CCCC,DDDD,BBBBBB
what I need to do is to remove duplication as below:
AAAA,BBBBBB,CCCC,DDDD
Any one can help with VBA code..
Thanks.

How to remove duplication in text string?
 

I have text string with Comma separated for example:
AAAA,CCCC,BBBBBB,CCCC,DDDD,CCCC,DDDD,BBBBBB
what I need to do is to remove duplication as below:
AAAA,BBBBBB,CCCC,DDDD
Any one can help with VBA code..

Give this function (which can be used as a UDF) a try...

Function DeDupe(ByVal S As String, Optional Delimiter As String = ",") As
String
Dim X As Long, Parts() As String, TwoParts() As String
Parts = Split(S, Delimiter)
For X = 0 To UBound(Parts)
TwoParts = Split(S, Parts(X), 2)
TwoParts(1) = Replace(TwoParts(1), Parts(X), "")
S = Join(TwoParts, Parts(X))
Next
Do While InStr(S, Delimiter & Delimiter)
S = Replace(S, Delimiter & Delimiter, Delimiter)
Loop
If Right(S, 1) = "," Then S = Left(S, Len(S) - 1)
DeDupe = S
End Function

Rick Rothstein (MVP - Excel)

How to remove duplication in text string?
 

On Wed, 16 Nov 2011 06:35:57 -0800 (PST), geniusideas wrote:

Hi,

I have text string with Comma separated for example:
AAAA,CCCC,BBBBBB,CCCC,DDDD,CCCC,DDDD,BBBBBB
what I need to do is to remove duplication as below:
AAAA,BBBBBB,CCCC,DDDD
Any one can help with VBA code..
Thanks.

Based on your example, it seems you want to not only remove the duplicates, but also alphabetize the unique values.
That being the case, this User Defined Function (UDF) may do what you require.

To enter this User Defined Function (UDF), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this User Defined Function (UDF), enter a formula like

=UniqueCSV(A1)

in some cell.

===========================
Option Explicit
Function UniqueCSV(s As String) As String
Dim sStrings As Variant
Dim s2()
Dim collStrings As Collection
Dim i As Long
sStrings = Split(s, ",")

'Get unique list
Set collStrings = New Collection
On Error Resume Next
For i = 0 To UBound(sStrings)
collStrings.Add Item:=CStr(sStrings(i)), Key:=CStr(sStrings(i))
Next i
On Error GoTo 0
ReDim s2(1 To collStrings.Count)
For i = 1 To collStrings.Count
s2(i) = collStrings(i)
Next i

Quick_Sort s2, 1, UBound(s2)

UniqueCSV = Join(s2, ",")
End Function

'--------------------------------------------------------
Sub Quick_Sort(ByRef SortArray As Variant, ByVal First As Long, ByVal Last As Long)
Dim Low As Long, High As Long
Dim Temp As Variant, List_Separator As Variant
Low = First
High = Last
List_Separator = SortArray((First + Last) / 2)
Do
Do While (SortArray(Low) < List_Separator)
Low = Low + 1
Loop
Do While (SortArray(High) List_Separator)
High = High - 1
Loop
If (Low <= High) Then
Temp = SortArray(Low)
SortArray(Low) = SortArray(High)
SortArray(High) = Temp
Low = Low + 1
High = High - 1
End If
Loop While (Low <= High)
If (First < High) Then Quick_Sort SortArray, First, High
If (Low < Last) Then Quick_Sort SortArray, Low, Last
End Sub
===================================