Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
Solved

# Remove duplicate within cell.

Posted on 2013-01-14
Medium Priority
378 Views
Hello all.

I have a data set with eleven columns. The last column contains a set of codes separated by commas - sample '1, 2, 3'.

In some cases I have duplicate codes '1, 2, 2, 3'.

I need to remove the duplicate code... result '1, 2, 3'.

Suggestions?
0
Question by:model_un
• 3
• 2

LVL 14

Expert Comment

ID: 38775044
this vba may work

Sub Remove_DupesInString()
' this puts the final value in column J
Dim starval As String
Dim finval As String
Dim strarray() As String
Dim x As Long
Dim k As Long
' step through each cell in range
For Each cell In Sheets(1).Range("A1:A500")
Erase strarray ' erase array
finval = "" ' erase final value"
starval = cell.Value

strarray = Split(starval, ",")

'Step through length of string and look for duplicate
For rw = 0 To UBound(strarray)

For k = rw + 1 To UBound(strarray)
If Trim(strarray(k)) = Trim(strarray(rw)) Then
strarray(k) = "" 'if duplicate clear array value
End If
Next k
Next rw

' combine all value in string less duplicate
For x = 0 To UBound(strarray)
If strarray(x) <> "" Then

finval = finval & Trim(strarray(x)) & ", "
End If

Next x
' remove last space and comma
finval = Trim(finval)
finval = Left(finval, Len(finval) - 1)
' output value to Column J
cell.Offset(0, 9).Value = finval

Next cell

End Sub
0

LVL 24

Expert Comment

ID: 38775070
This should be faster and easier to use on a single cell...

paste the code into a new module in the workbook and then use =RemoveInCellDuplicates as a normal function.

``````Option Explicit

Function RemoveInCellDuplicates(inString As String) As String
Dim arr, x As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

arr = Split(inString, ",")

For x = 0 To UBound(arr)
If Not Dic.exists(arr(x)) Then Dic.Add arr(x), arr(x)
Next x

RemoveInCellDuplicates = Join(Dic.Items, ",")

End Function
``````
RemoveInCellDuplicates.xlsm
0

Author Comment

ID: 38775092
Thank you Emes.

I'm getting a run time error '5'.

When I go to debug, it is highlighting the following line:  finval = Left(finval, Len(finval) - 1)

Solution?

FF
0

Author Comment

ID: 38775168
Thank you The_Barman.

I was about to accept your solution when I found a hiccup... it would seem that when the first number is repeated the function does not remove the duplicate.

For example:

328, 328, 482, 482  is coming back 328, 328, 482

Any ideas?

FF
0

LVL 24

Accepted Solution

Steve earned 2000 total points
ID: 38775214
it must be leading or trailing spaces... try...

``````Option Explicit

Function RemoveInCellDuplicates(inString As String) As String
Dim arr, x As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")

arr = Split(inString, ",")

For x = 0 To UBound(arr)
If Not Dic.exists(trim(arr(x))) Then Dic.Add trim(arr(x)), trim(arr(x))
Next x

RemoveInCellDuplicates = Join(Dic.Items, ",")

End Function
``````
RemoveInCellDuplicates.xlsm
0

Author Closing Comment

ID: 38775240
Excellent. Many Thanks!
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
###### Suggested Courses
Course of the Month13 days, 1 hour left to enroll