remove dupes in a cell

need to remove all the dupes WITHIN a comma

world, leader, recognized, entirety, utility, system system system system, Standards Standards standards standard standards, Automated, portable, national, system


world, leader, recognized, entirety, utility, system, Standards standard , Automated, portable, national, system
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Shaun VermaakTechnical SpecialistCommented:
Would have written one but found this
Function RemoveDuplicates(str)
  If Trim(str) = "" Then
    RemoveDuplicates = Array()
    Exit Function
  End If

  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = vbTextCompare  'make dictionary case-insensitive

  For Each elem In Split(str, ",")
    d(elem) = True

  RemoveDuplicates = d.Keys
End Function

Open in new window
Martin LissOlder than dirtCommented:
Add a sheet called "Helper" to your workbook and then run this macro. You can hide the Helper sheet if you like.
Sub DeleteWithinComma()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngRowH As Long
Dim strWords() As String
Dim strParts() As String
Dim lngIndex As Long
Dim lngIndex2 As Long
Dim wsH As Worksheet

Set wsH = Sheets("Helper")
Const DATA_COL = "A" ' Change as needed
Const FIRST_ROW = 1 ' Change as needed

lngLastRow = Range(DATA_COL & "1048576").End(xlUp).Row

For lngRow = FIRST_ROW To lngLastRow
    strWords = Split(Trim(Cells(lngRow, DATA_COL)), ",")
    For lngIndex = 0 To UBound(strWords)
        strParts = Split(Trim(strWords(lngIndex)))
        For lngIndex2 = 0 To UBound(strParts)
            wsH.Cells(lngIndex2 + 1, "A") = Trim(strParts(lngIndex2))
        On Error Resume Next
        wsH.Range("$A$1:$A$" & wsH.UsedRange.Rows.Count).RemoveDuplicates Columns:=1, Header:=xlNo
        strWords(lngIndex) = ""
        For lngRowH = 1 To wsH.UsedRange.Rows.Count
            strWords(lngIndex) = strWords(lngIndex) & wsH.Cells(lngRowH, "A") & " "

    Cells(lngRow, DATA_COL).ClearContents
    For lngIndex = 0 To UBound(strWords)
        Cells(lngRow, DATA_COL) = Cells(lngRow, DATA_COL) & strWords(lngIndex) & ", "
    Cells(lngRow, DATA_COL) = Left(Cells(lngRow, DATA_COL), Len(Cells(lngRow, DATA_COL)) - 2)
End Sub

Open in new window

finnstoneAuthor Commented:
martin, that did not work.  it seemed to have wiped entire workbook

other guy, that removed all but one entry
Exploring ASP.NET Core: Fundamentals

Learn to build web apps and services, IoT apps, and mobile backends by covering the fundamentals of ASP.NET Core and  exploring the core foundations for app libraries.

Martin LissOlder than dirtCommented:
it seemed to have wiped entire workbook
That didn't happen for me so try it with this workbook.

Edit: I'm going to a play and dinner so I won't be available for several hours.
Bill PrewIT / Software Engineering ConsultantCommented:
Same approach I took last time, see attached and VBA code within.



Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Fabrice LambertConsultingCommented:

you can attempt to insert the word in a collection, if it fail, it is a duplicate:
Option Compare Database
Option Explicit
Option Base 0

Public Function removeDuplicateWords(ByVal strIn As String)
    Dim data() As String
    Dim strOut As String
    Dim i As Long
    Dim col As Collection
    data = Split(strIn, ",")
    Set col = New Collection
    For i = LBound(data) To UBound(data)
        If Not (existInCollection(Trim(data(i)), col)) Then
            col.add Trim(data(i)), key:=Trim(data(i))
            If (strOut <> vbNullString) Then
                strOut = strOut & ", "
            End If
            strOut = strOut & Trim(data(i))
        End If
    Set col = Nothing
    removeDuplicateWords = strOut
End Function

Public Function existInCollection(ByVal key As String, ByRef col As Object) As Boolean
    existInCollection = existInCollectionByVal(key, col) Or existInCollectionByRef(key, col)
End Function

Private Function existInCollectionByVal(ByVal key As String, ByRef col As Object) As Boolean
On Error GoTo Error
    Dim value As Variant
    existInCollectionByVal = True
    value = col(key)
Exit Function
    existInCollectionByVal = False
End Function

Private Function existInCollectionByRef(ByVal key As String, ByRef col As Object) As Boolean
On Error GoTo Error
    Dim value As Object

    existInCollectionByRef = True
    Set value = col(key)
Exit Function
    existInCollectionByRef = False
End Function

Open in new window

Dim strTest As String

strTest = "world, leader, recognized, entirety, utility, system, system, system, system, Standards, Standards, standards, standard, standards, Automated, portable, national, system"
strTest = removeDuplicateWords(strTest)
Debug.Print strTest

Open in new window

Side note: It is case insensitive.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

From novice to tech pro — start learning today.