Remove Duplicates From Single Cell

rajtak

Board Regular
Joined
Feb 23, 2009
Messages
74
I have a column that has duplicate information in it.
An exapmle of one of the cells is:
BL, BL, BN, BOL, BOL, CP, CP, DRE, EG, EG, LM, LM, R, RE, RE, SP, SP, W, W

I want a function OR vba macro to go thru the column and delete the duplicates in each cell.

So this one will be:
BL, BN, BOL, CP, DRE, EG, LM, R, RE, SP, W

Thanks for any help
 
Try modifying Richard's code just a bit:

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br>  <br><SPAN style="color:#00007F">Sub</SPAN> remDup()<br><SPAN style="color:#00007F">Dim</SPAN> dic <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, cell <SPAN style="color:#00007F">As</SPAN> Range, temp <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>  <br>  <SPAN style="color:#00007F">Set</SPAN> dic = CreateObject("scripting.dictionary")<br>  <br>  <SPAN style="color:#00007F">With</SPAN> dic<br>      <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> cell <SPAN style="color:#00007F">In</SPAN> Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)<br>          .RemoveAll<br>          <SPAN style="color:#00007F">If</SPAN> Len(cell.Value) > 0 <SPAN style="color:#00007F">Then</SPAN><br>              temp = Split(cell.Value, vbLf)<br>              <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(temp)<br>                  <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> .Exists(temp(i)) <SPAN style="color:#00007F">Then</SPAN> .Add temp(i), temp(i)<br>              <SPAN style="color:#00007F">Next</SPAN> i<br>              cell.Value = Join(.keys, ", ")<br>          <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Next</SPAN> cell<br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>          <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope that helps,

Mark
 
Upvote 0

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
how about replacing "," in Richard's macro with Chr(10) ?

Sub remDup()
Dim dic As Object, cell As Range, temp As Variant
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
With dic
For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
.removeall
If Len(cell.Value) > 0 Then
temp = Split(" " & cell.Value, Chr(10))
For i = 0 To UBound(temp)
If Not .Exists(temp(i)) Then .Add temp(i), temp(i)
Next i
cell.Value = Mid(Join(.Keys, Chr(10)),2)
End If
Next cell
End With

End Sub
 
Upvote 0
Yetti,

I believe I just recreated your issue on my computer by typing an "a" into a cell, followed by many alt-enters, and then finally inputting a "d".

In Excel, these values are show in a single cell as illustrated below:

Code:
a


d

When I paste this text into Microsoft's "Notepad", I get "ad" (with the quotes as shown directly below). If this is what you're looking for, then I would do that.

Code:
"ad"

If it's not, then I would download a free, open source program called Notepad++ (which is also a text editor) and then paste the data into there. When I paste my example into Notepad++, I get the following.

Code:
"a



d"

You could then run a search and replace for a double quote mark (i.e., the "), and then replace with nothing. Paste that data back into Excel and you can go about removing your duplicates.

All of this is necessary, because a line break (when you hit the "Enter" key) is a character. There are two types of them. ASCII Character #10 and 13. I will not go on the tangent that I was about to go on, but just know that's the reason why you're having the experience that you are. Let me know if you want the additional details/tangent.
 
Last edited:
Upvote 0
I appreciate everyone's prompt input! Each line of data in the individual cells are used to identify the catalog number and barcode information for supplies in a database. The challenge is that I need to keep each line of data on a separate line in each cell because the spreadsheet will be used to import to the database. Is there a way to remove the line breaks alt+enter to remove the duplicates and then re-add the line breaks to replace the commas?

Here is a visual walk-through of where I am am. The last image from Notepad is what the import spec should look like with the line breaks so the supply data is entered as multiple entries into the database.

kPcglFr.jpg
 
Upvote 0
Mark, you are the man! The task required me to clean up 25,000 rows of data that was appended instead of overwritten in the database and I was in dire need of help. Thank you - Jeff -
 
Upvote 0
sir,
I am new to vba below code is for only for one column but I have range A1:J76 each cell contains duplicate values and I want to highlight or mark with * star,
pls help me,

regards
rao


Hi

The following assumes it is column A containing these value - it will need to be modified if not:

Code:
Sub remDup()
Dim dic As Object, cell As Range, temp As Variant
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
With dic
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .removeall
        If Len(cell.Value) > 0 Then
            temp = Split(cell.Value, ",")
            For i = 0 To UBound(temp)
                If Not .Exists(temp(i)) Then .Add temp(i), temp(i)
            Next i
            cell.Value = Join(.Keys, ",")
        End If
    Next cell
End With
        
End Sub
 
Upvote 0
Hi,
thank you,
This code works fine but I want to highlight with the color red, not to remove,
can we replace .removeall with some thing else which will only highlight the duplicates?

thanks
rao



Hi

The following assumes it is column A containing these value - it will need to be modified if not:

Code:
Sub remDup()
Dim dic As Object, cell As Range, temp As Variant
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
With dic
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .removeall
        If Len(cell.Value) > 0 Then
            temp = Split(cell.Value, ",")
            For i = 0 To UBound(temp)
                If Not .Exists(temp(i)) Then .Add temp(i), temp(i)
            Next i
            cell.Value = Join(.Keys, ",")
        End If
    Next cell
End With
        
End Sub
 
Upvote 0
Hi Richard,

I am trying to use this code however I keep getting an error and when I go to debug Excel highlights "If Len(cell.Value) > 0 Then" . I am working on a file about 30,000 cells long. Thank you for your time and help with this issue.

Josh


Hi

The following assumes it is column A containing these value - it will need to be modified if not:

Code:
Sub remDup()
Dim dic As Object, cell As Range, temp As Variant
Dim i As Long
Set dic = CreateObject("scripting.dictionary")
With dic
    For Each cell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        .removeall
        If Len(cell.Value) > 0 Then
            temp = Split(cell.Value, ",")
            For i = 0 To UBound(temp)
                If Not .Exists(temp(i)) Then .Add temp(i), temp(i)
            Next i
            cell.Value = Join(.Keys, ",")
        End If
    Next cell
End With
        
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,261
Messages
6,123,942
Members
449,134
Latest member
NickWBA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top