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 duplicate entries I need to remove those entries. Most of what I've seen in VBA is used to remove duplicates values within a column, but I can't find a way to remove duplicate values within a row.

Name  |        Address1 |       Address2 |    City |    Country

Peter | 2 foobar street |2 foobar street |  Boston |    USA

And I want it to be like :

Name  |         Address1 |  Address2 |   City  |    Country

Peter | 2 foobar street  |           |  Boston |    USA

I've write a macro that will loop through all the rows and then every columns for each rows, but I have no clue as to how to spot duplicate within teh different cells within teh same row.

here's the code below:

Sub Removedupe()   
   Dim LastRow As Long
   Dim LastColumn As Long
   Dim NextCol As Long

   LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row    
   LastColumn = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

   For counterRow = 1 To LastRow               
       'I'm stuck here: how to remove a duplicate values within that row?         
   Next counterRow   
End Sub

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

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

Answer 3

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 4

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