remove dupes in a cell

finnstone
finnstone used Ask the Experts™
on
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

to

world, leader, recognized, entirety, utility, system, Standards standard , Automated, portable, national, system
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Shaun VermaakTechnical Specialist
Awarded 2017
Distinguished Expert 2018

Commented:
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
  Next

  RemoveDuplicates = d.Keys
End Function

Open in new window

https://stackoverflow.com/questions/20310609/how-to-remove-duplicates-from-an-array
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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
    wsH.UsedRange.ClearContents
    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))
        Next
        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") & " "
        Next
    Next

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

Open in new window

Author

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

other guy, that removed all but one entry
Become a Certified Penetration Testing Engineer

This CPTE Certified Penetration Testing Engineer course covers everything you need to know about becoming a Certified Penetration Testing Engineer. Career Path: Professional roles include Ethical Hackers, Security Consultants, System Administrators, and Chief Security Officers.

Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.
29071633.xlsm
IT / Software Engineering Consultant
Top Expert 2016
Commented:
Same approach I took last time, see attached and VBA code within.

EE29071633.xlsm


»bp
Fabrice LambertConsulting
Distinguished Expert 2017

Commented:
Hi,

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
    Next
    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
Resume
Error:
    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
Error:
    existInCollectionByRef = False
End Function

Open in new window

Usage:
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.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial