need to remove duplicate words in a cell

have a column of cells like this

ORIGINAL
world, industry, generation, industry
leader, leader, Covered, supplies
transformation, margin

NEED THIS TO BE
world, industry, generation
leader, Covered,
transformation, margin
finnstoneAsked:
Who is Participating?

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

x
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.

Pawan KumarDatabase ExpertCommented:
SELECT that column -> go to DATA tab -> CLICK remove duplicates--> You are done.
0
finnstoneAuthor Commented:
that is not correct
0
finnstoneAuthor Commented:
dupes only should be removed from within the same cell
0
OWASP Proactive Controls

Learn the most important control and control categories that every architect and developer should include in their projects.

Pawan KumarDatabase ExpertCommented:
Is it a one time activity ?
0
Bill PrewIT / Software Engineering ConsultantCommented:
Here are some VBA procs you can use.  Attaching a sheet as an example.

If you want to remove duplicate words and place results in a new cell you can use the DeDupeText() function to do that.  See sample sheet, column B.

If you want to remove duplicate words in each cell in the whole A column, you can run DeDupe().

Hopefully this gives you the idea...

Option Explicit

Sub DeDupe()
    DeDupeRange Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row)
End Sub

Sub DeDupeRange(rngTarget As Range)
    Dim rngCell As Range
    For Each rngCell In rngTarget
        rngCell.Value = DeDupeText(rngCell.Value)
    Next
End Sub

Function DeDupeText(strText As String) As String
    Dim arrWord() As String
    Dim strWord As Variant

    DeDupeText = ""

    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare

        arrWord = Split(strText, ",")
        For Each strWord In arrWord
            If Not .Exists(Trim(strWord)) Then
                .Add Trim(strWord), 1
                If DeDupeText = "" Then
                    DeDupeText = strWord
                Else
                    DeDupeText = DeDupeText & "," & strWord
                End If
            End If
        Next
    End With

End Function

Open in new window


EE29071578.xlsm


»bp
0

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
Martin LissOlder than dirtCommented:
Ignore this if Bill's code works for you.

Otherwise add and run this macro. Note lines 8 and 9.

Sub RemoveCellDupes()
Dim lngLastRow As Long
Dim lngRow As Long
Dim colWords As Collection
Dim strWords() As String
Dim lngIndex As Long
Dim lngNextRow As Long
Const DATA_COL = "A" ' Change as needed
Const FIRST_ROW = 1 ' Change as needed

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

For lngRow = FIRST_ROW To lngLastRow
    Set colWords = New Collection
    strWords = Split(Cells(lngRow, DATA_COL), ",")
    For lngIndex = 0 To UBound(strWords) 
        On Error Resume Next
        colWords.Add Trim(strWords(lngIndex)), Trim(strWords(lngIndex))
    Next
    Cells(lngNextRow, DATA_COL).ClearContents
    For lngIndex = 1 To colWords.Count
        If lngIndex < colWords.Count Then
            Cells(lngNextRow, DATA_COL) = Cells(lngNextRow, DATA_COL) & colWords(lngIndex) & ", "
        Else
            Cells(lngNextRow, DATA_COL) = Cells(lngNextRow, DATA_COL) & colWords(lngIndex)
        End If
    Next
    lngNextRow = lngNextRow + 1
Next
End Sub

Open in new window

0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Assuming each word in the cell is separated by a comma, you may give this a try...
Function getUniqueWords(ByVal vStr As String) As String
Dim str() As String
Dim dict
Dim i As Long

str = Split(Replace(Replace(vStr, Chr(10), ""), " ", ""), ",")
Set dict = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(str)
    dict.Item(str(i)) = ""
Next i
If dict.Count > 0 Then getUniqueWords = Join(dict.keys, ", ")
End Function

Open in new window


Assuming your string is in A2 then use this user defined function on the sheet like below...
=getUniqueWords(A2)

Open in new window

0
finnstoneAuthor Commented:
awesome thanks Bill
0
finnstoneAuthor Commented:
Bill, got a new one. This time, I just need to remove dupes within the commas

https://www.experts-exchange.com/questions/29071630/remove-dupes-part-2.html
0
finnstoneAuthor Commented:
0
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
VBA

From novice to tech pro — start learning today.