VBA: How to remove multiple duplicate values in excel cells in multiple column if found

[azov5]

Issue: Multiple duplicate values in excel cell.
I have multi column data A to AA. In some cells I have multiple duplicate values in each cell (contains numbers and alphabets and special characters) separated by comma. How to remove multiple duplicates and keep only the unique values in each cell separated by comma. If cells contains only comma then keep the cell blank.

 

[JoeMo]

Can you post some sample data, including data for a cell that "contains only comma"?

 

[azov5]

empty cell comma are like:
,
,,
,,,,,,,
,,,

 

[JoeMo]

..... and some sample data for the cells with multiple duplicate values?

 

[azov5]

Pan , Pan , Pan
A-*01:0, A-*01:0, A-*01:0, A-*01:0
Rose, Rose, -C*01:0, -C*01:0
Rose, A-C*01:0

 

[azov5]

comma i can manage. I just want to remove the duplicate multiple values in each excel cell if found.

 

[JoeMo]

Lightly tested. Note: assumes strings with multiple duplicate values have a ", " (comma followed by a space) delimiter. Data assumed to be in col A starting in A1.

Sub azov5()
'Assumes data in col A starting in A1, strings have comma and space delimiters
'Duplicate values within a cell are removed. Cells holding only commas
'are cleared
Dim R As Range, V As Variant, i As Long, S As Variant, d As Object
Set R = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
V = R.Value
Set d = CreateObject("Scripting.dictionary")
For i = 1 To UBound(V, 1)
    If InStr(V(i, 1), ",") > 0 Then
        If Replace(V(i, 1), ",", "") = "" Then
            V(i, 1) = ""
        Else
            S = Split(V(i, 1), ", ")
            For j = LBound(S) To UBound(S)
                If Not d.exists(S(j)) Then
                    d.Add S(j), d.Count + 1
                End If
            Next j
            V(i, 1) = Join(d.keys, ", ")
            d.RemoveAll
        End If
    End If
Next i
R.Value = V
End Sub

 

[JoeMo]

Just noticed your thread title indicates duplicate values may be in more than one column. This version assumes your data to be modified occupies the entire used range of the active sheet.

Sub azov5_2()
'Assumes data occupy entire used range of activesheet, and strings have comma and space delimiters
'Duplicate values within a cell are removed. Cells holding only commas
'are cleared
Dim R As Range, V As Variant, i As Long, j As Long, col As Long, S As Variant, d As Object
Set R = ActiveSheet.UsedRange  
V = R.Value
Set d = CreateObject("Scripting.dictionary")
For i = 1 To UBound(V, 1)
    For col = LBound(V, 2) To UBound(V, 2)
        If InStr(V(i, col), ",") > 0 Then
            If Replace(V(i, col), ",", "") = "" Then
                V(i, col) = ""
            Else
                S = Split(V(i, col), ", ")
                For j = LBound(S) To UBound(S)
                    If Not d.exists(S(j)) Then
                        d.Add S(j), d.Count + 1
                    End If
                Next j
                V(i, col) = Join(d.keys, ", ")
                d.RemoveAll
            End If
        End If
    Next col
Next i
R.Value = V
End Sub

 

[azov5]

If InStr(V(i, col), ",") > 0 Then

debug issue

 

[JoeMo]

If InStr(V(i, col), ",") > 0 Then

debug issue

What is the error message that accompanies the debugger highlighting that line? Did you copy the code from your browser and paste it to the VBE window or did you try to type it in manually?