Home » excel » excel – Remove Duplicate Cells in a Row

excel – Remove Duplicate Cells in a Row

Posted by: admin May 14, 2020 Leave a comment


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
How to&Answers:

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


Maybe this in your loop:

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


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"
      // 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.


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