Try this code:
Sub SubRemoveDuplicates()
'Declarations.
Dim RngData As Range
Dim RngDataToBeCompared
Dim RngCell As Range
Dim RngRow As Range
'Settings.
Set RngData = Range("A1:C6")
Set RngDataToBeCompared = Range("B2:C6")
'Covering each row of the data to be compared.
For Each RngRow In RngDataToBeCompared.Rows
CP_Rerun_For:
'Covering each cell of the given row.
For Each RngCell In RngRow.Cells
'Checking if any cell is different from the one under it.
If RngCell.Value <> RngCell.Offset(1, 0).Value Then
'If said cell has been found, skip to the next row.
GoTo CP_Next_Row
End If
Next
'Checking if the range to be targeted is within RngData.
If Not Intersect(RngRow.Offset(1, 0).EntireRow, RngData) Is Nothing Then
'Deleting the row of duplicates.
Intersect(RngRow.Offset(1, 0).EntireRow, RngData).Delete (xlShiftUp)
'Rerunning this cycle for the given row in order to catch duplicates that comes in more than 2.
GoTo CP_Rerun_For
End If
CP_Next_Row:
Next
End Sub
Note: if you are going to cover an entire column with presumably many empty cells, the macro will cover (and eventually delete) all those empty cells too. The macro can be modified so it will stop when it encounters and empty row, or to dynamically determinate the appropriate range to be covered. Otherwise it might take more time than necessary.
