Remove Duplicates From Single Cell

[rajtak]

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

 

[Richard Schollar]

Hi

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

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

 

[rajtak]

Hi Richard, Thanks for your help, but for some reason VBA Macro didn't work.

may be i was not clear in explaining the problem.

I have a column that has duplicate information in it.
An exapmle of one of the cells is: (In cell A1) Red colored are duplicates in the cell.
CA, MW, CA, ABC, QB, MW

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

So this one will be: (In cell A1)
CA, MW, ABC, QB

All these values are comma separated in each cell. Thanks for any help

 

[Richard Schollar]

That's what the macro does - do you get an error when you run the code? It only looks in column A from A1 to Aend (where Aend will be the last populated cell in column A). If you do get an error, what is it and on which line do you get it?

 

[rajtak]

Hi Richard,

I didn't get any error, The Macro run normally without any error.

 

[Richard Schollar]

Should work then unless you have spaces with these values (ie the values between the commas are not only word characters. Try the following code instead. Note that the sheet containing these values does need to be visible on your Excel screen whn you run the 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(Replace(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

 

[rajtak]

Hi Richard,
This Macro works, but i have spaces within values and i don't want those to be removed.

 

[Richard Schollar]

Try this instead:

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 = Mid(Join(.Keys, ","),2)
        End If
    Next cell
End With
        
End Sub

 

[rajtak]

Thanks a million. You've solved my big problem. Macro works exactly as i wanted.

 

[Yetti]

I have a similar issue but the data in the same cell is separated on a new line by pressing alt+enter in Excel.

The data looks like this in the spreadsheet:

21475​

H749201003000​

H749201003000​

21475​

H749201003000​