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