Deleting Duplicates in Cells-CodePudding

I am stuck on this, and being new to VBA, don't have any code to show.

My problem is this:

A column in my spreadsheet is generating duplicate entries. An example cell might contain the following information.

 Item-num1 Item-num1
 Item-num2 Item-num2
 ......... .........
 Item-num### Item-num###

I need it to only include the one of each item in the cell for the entire column.

Is this something best done in a loop or is there some built in functions that can help me out? Any advice would be much appreciated. Please reach out with any questions. Thank you!

CodePudding user response：

How you get these deuplicates, is the data generated via VBA macro or other way? Also, easier way, if data looks the same way as you mentioned, you could use text to column functionality, delimited by space. The data would be split into 2 columns and you could simply delete 2nd column

CodePudding user response：

There is no built-in function/method to remove duplicates in a cell.

Please, try the next function. It is able to remove many (different, if the case) duplicates:

Function RemoveCellDup(strVal As String) As String
    Dim arr, i As Long, dict As Object
    
     arr = Split(strVal)
     If UBound(arr) = 0 Then RemoveCellDup = strVal: Exit Function
     'extract unique:
     Set dict = CreateObject("Scripting.Dictionary")
     For i = 0 To UBound(arr)
        dict(arr(i)) = vbNullString
     Next i
     RemoveCellDup = Join(dict.Keys, " ")
End Function

It can be tested as:

Sub TestRemoveCellDup()
   Dim x As String
   x = "Item-num1 Item-num1"
   'x = "cat, dog, bear, dog, cat, cat, dear" 'uncomment to test it...
   Debug.Print RemoveCellDup(x)
End Sub

The above function can be used as UDF, but the fastest solution will be to place all the column (range) in an array, process it in memory and drop the array content at the end of the code, at once:

Sub removeRangeCellDuplicates()
   Dim ws As Worksheet, lastR As Long, rngDpl As Range, arr, i As Long
   
   Set ws = ActiveSheet
   lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'last row
   Set rngDpl = ws.Range("A2:A" & lastR)
   arr = rngDpl.Value2 'place the range in an array for faster iteration/processing
   
   For i = 1 To UBound(arr)
        arr(i, 1) = RemoveCellDup(CStr(arr(i, 1)))
   Next i
   rngDpl.Value2 = arr
End Sub