Link to home
Create AccountLog in
Avatar of finnstone
finnstone

asked on

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
Avatar of Pawan Kumar
Pawan Kumar
Flag of India image

SELECT that column -> go to DATA tab -> CLICK remove duplicates--> You are done.
Avatar of finnstone
finnstone

ASKER

that is not correct
dupes only should be removed from within the same cell
Is it a one time activity ?
ASKER CERTIFIED SOLUTION
Avatar of Bill Prew
Bill Prew

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account
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

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

awesome thanks Bill
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