Remove Duplicate Cells in a Row

Question

Just to clarify : I don\'t want to remove duplicates rows, I want to remove Duplicate Cells within a row

So here\'s a classic address table, and in some row there\'s

Answer 1

In your case, the duplicates are adjacent. To clear duplicates in either a single column or single row for this special case:

Sub qwerty()
    Dim r As Range, nR As Long
    Set r = Intersect(Cells(13, 1).EntireRow, ActiveSheet.UsedRange)
    nR = r.Count
    For i = nR To 2 Step -1
        If r(i) = r(i - 1) Then
            r(i) = ""
        End If
    Next i
End Sub

This code is an example for row #13

Answer 2

Probably the easiest would be with a dictionary. Read the current cell. If it is already in the dictionary then blank out the cell, otherwise add it to the dictionary.

Dim dict As New Scripting.Dictionary 
For counterRow = 1 To LastRow         
   key = // get the current cell value
   If Not dict.Exists(key) Then 
       dict.Add key, "1"
   Else
      // clear current cell
End If Next counterRow 

More on dictionary here: Does VBA have Dictionary Structure?

PS: Note that my solution removes all duplicates, not just if they are in the 2nd and 3rd column as in your example.

Answer 3

Maybe this will solve your problem:

Sub RemoveDuplicatesInRow()

    Dim lastRow As Long
    Dim lastCol As Long
    Dim r As Long 'row index
    Dim c As Long 'column index
    Dim i As Long

    With ActiveSheet.UsedRange
        lastRow = .Row + .Rows.Count - 1
        lastCol = .Column + .Columns.Count - 1
    End With

    For r = 1 To lastRow
        For c = 1 To lastCol
            For i = c + 1 To lastCol 'change lastCol to c+2 will remove adjacent duplicates only
                If Cells(r, i) <> "" And Cells(r, i) = Cells(r, c) Then
                    Cells(r, i) = ""
                End If
            Next i
        Next c
    Next r

End Sub

Answer 4

Maybe this in your loop:

If Range("A1").Offset(counterRow,1) = Range("A1").Offset(counterRow,2) Then
    Range("A1").Offset(counterRow,2).Clear
End If