Duplicate entries in a CELL

[dhally]

Hello,
I have a range of cells (H2:H3398). Some cells contain duplicate entries for example: HENRICH; OLD #3175460; UCI1089-CABLES, OLD #3175460 .

Not all cells contain duplicate entries however.

Is there a formula for removing unwanted duplicate entries as indicated in the red font through the range of cells?

 

[MrKowz]

Is there a comma or a semicolon that separates entries? In your example, I am seeing both.

 

[dhally]

Yes, there are comma's and semicolons separating the information. I could do a simple find and replace to get rid of the semicolons.

 

[MrKowz]

Yes, there are comma's and semicolons separating the information. I could do a simple find and replace to get rid of the semicolons.

Do that, replace all semicolons with commas so we have a consistent delimiter, then run the following code:

Public Sub RemoveDupEntries()
Dim i       As Long, _
    j       As Long, _
    LR      As Long, _
    temparr As Variant, _
    temp    As String, _
    delim   As String
    
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
delim = ","
LR = Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To LR
    Application.StatusBar = "Currently checking row " & i & " of " & LR
    If Len(Range("H" & i).Value) > 0 Then
        temparr = Split(Range("H" & i).Value, delim)
        For j = LBound(temparr) To UBound(temparr)
            If InStr(temp, temparr(j)) = 0 Then
                temp = temp & temparr(j) & delim & " "
            End If
        Next j
        If Right$(temp, 2) = delim & " " Then
            Range("H" & i).Value = Left$(temp, Len(temp) - 2)
        Else
            Range("H" & i).Value = temp
        End If
    End If
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
End Sub

 

[dhally]

Ok. I replaced all the semicolons with commas. After pasting in the code below, it removed the duplicate entry but inserted the remaining entry (which was in H2) into the beginning of each cell from H3 through H3398. This is what say, H2:H10 looked like before the code:
<table border="0" cellpadding="0" cellspacing="0" width="1759"><col style="width: 1319pt;" width="1759"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 1319pt;" width="1759" height="20">HENRICH; OLD #3175460; UCI1089-CABLES</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH; 155-000-738 DON HARMAN $148.00</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; background: none repeat scroll 0% 0% yellow;" height="20"> </td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">DAVIS STANDARD</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH; 308072</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">GEM GRAVURE</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">NORTHAMPTON</td> </tr> </tbody></table>
This is what H2:H10 it looks like after pasting in the code:
<table border="0" cellpadding="0" cellspacing="0" width="1790"><col style="width: 1343pt;" width="1790"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 1343pt;" width="1790" height="20">HENRICH, OLD #3175460, UCI1089-CABLES</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; background: none repeat scroll 0% 0% yellow;" height="20"> </td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD, 308072</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD, 308072, GEM GRAVURE</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD, 308072, GEM GRAVURE, NORTHAMPTON</td> </tr> </tbody></table>

Public Sub RemoveDupEntries()
Dim i As Long, _
j As Long, _
LR As Long, _
temparr As Variant, _
temp As String, _
delim As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
delim = ","
LR = Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To LR
Application.StatusBar = "Currently checking row " & i & " of " & LR
If Len(Range("H" & i).Value) > 0 Then
temparr = Split(Range("H" & i).Value, delim)
For j = LBound(temparr) To UBound(temparr)
If InStr(temp, temparr(j)) = 0 Then
temp = temp & temparr(j) & delim & " "
End If
Next j
If Right$(temp, 2) = delim & " " Then
Range("H" & i).Value = Left$(temp, Len(temp) - 2)
Else
Range("H" & i).Value = temp
End If
End If
Next i
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub</pre>

 

[MrKowz]

Hmm - try:

Public Sub RemoveDupEntries()
Dim i       As Long, _
    j       As Long, _
    LR      As Long, _
    temparr As Variant, _
    temp    As String, _
    delim   As String
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
delim = ","
LR = Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To LR
    Application.StatusBar = "Currently checking row " & i & " of " & LR
    If Len(Range("H" & i).Value) > 0 Then
        temparr = Split(Range("H" & i).Value, delim)
        For j = LBound(temparr) To UBound(temparr)
            If InStr(temp, temparr(j)) = 0 Then
                temp = temp & temparr(j) & delim & " "
            End If
        Next j
        If Right$(temp, 2) = delim & " " Then
            Range("H" & i).Value = Left$(temp, Len(temp) - 2)
        Else
            Range("H" & i).Value = temp
        End If
    End If
[COLOR=red][B]   Erase temparr[/B][/COLOR]
Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
End Sub

 

[dhally]

Ok. This is H2:H10 before the code:

<table border="0" cellpadding="0" cellspacing="0" width="1759"><col style="width: 1319pt;" width="1759"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 1319pt;" width="1759" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, OLD #3174560
</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, 155-000-738 DON HARMAN $148.00</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl65" style="height: 15pt; background: none repeat scroll 0% 0% yellow;" height="20"> </td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">DAVIS STANDARD</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, 308072</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">GEM GRAVURE</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">NORTHAMPTON</td> </tr> </tbody></table>

This is H2:H10 after running the code:

<table border="0" cellpadding="0" cellspacing="0" width="1759"><col style="width: 1319pt;" width="1759"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 1319pt;" width="1759" height="20">HENRICH, OLD #3175460, UCI1089-CABLES</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00</td> </tr> <tr style="height: 15pt;" height="20"> <td class="xl66" style="height: 15pt; background: none repeat scroll 0% 0% yellow;" height="20"> </td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD, 308072</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD, 308072, GEM GRAVURE</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">HENRICH, OLD #3175460, UCI1089-CABLES, 155-000-738 DON HARMAN $148.00, DAVIS STANDARD, 308072, GEM GRAVURE, NORTHAMPTON</td> </tr> </tbody></table>

It seems to want to copy H2 and H3 down the length of the range.. Meaning the text in H2 and H3 is inserted before all remaining text in each cell down to H3398...

 

[MrKowz]

My apologies:

Public Sub RemoveDupEntries()
Dim i       As Long, _
    j       As Long, _
    LR      As Long, _
    temparr As Variant, _
    temp    As String, _
    delim   As String
    
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
delim = ","
LR = Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To LR
    Application.StatusBar = "Currently checking row " & i & " of " & LR
    If Len(Range("H" & i).Value) > 0 Then
        temparr = Split(Range("H" & i).Value, delim)
        For j = LBound(temparr) To UBound(temparr)
            If InStr(temp, temparr(j)) = 0 Then
                temp = temp & temparr(j) & delim & " "
            End If
        Next j
        If Right$(temp, 2) = delim & " " Then
            Range("H" & i).Value = Left$(temp, Len(temp) - 2)
        Else
            Range("H" & i).Value = temp
        End If
    End If
    Erase temparr
[B][COLOR=red]    temp = ""
[/COLOR][/B]Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
End Sub

 

[dhally]

Please, no apologies. I'm very grateful for you and this website.

The last code did the job. Now the fun part for me is studying and deciphering all of the codes in relation to their outcomes. I definitely want to understand it.

Thank you very much!

 

[dhally]

One more question...If I keep this code, say in Notepad, can simply replace the "H" range with whatever other range I may want to run this code with for instance, range "AC" ?