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

 

[Knifeman]

Sorry also wanted to state that before I click debug it Excel states "Run-time error '13': Type mismatch

 

[Cgomez]

How should I apply the following macro to several columns?

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("H1:H" & Cells(Rows.Count, "H").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

With this module I want to eliminate duplicates in several columns, not only one, pressing "ALT + F8", but so far I could apply this only to column "H". If I create another module the values from "Module 1" change automatically.

 

[sobuj53]

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

Thank you sir, it's perfect. I've took the liberty to modify your code to make it as a function, which can take only one cell (Range) as an argument. In case if anyone needs it,

Public Function RemoveDuplicate(ByVal cell As Range) As String

Dim dic As Object, temp As Variant
Dim i As Long
On Error Resume Next

Set dic = CreateObject("scripting.dictionary")
With dic
        .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
            RemoveDuplicate = Mid(Join(.Keys, ","), 2)
        End If
    
End With
 On Error GoTo 0
        
End Function