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
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 Range("A1").Offset(counterRow,2).Clear 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" 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.
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