Remove duplicates from Rows with the last Row only as reference

[zouhair_psi]

Hello, I would like to apologize first for my bad english

I need help editing a VBA macro.

The macro deletes all duplicates per cell (except the first one) on all columns,raws and starts with the first row.

I would like to change the macro to take the last row only as reference

this is the macro

Sub DeleteDuplicateEntries() 
Dim Cell As Range, Cel As Range, N& 
Application.ScreenUpdating = False 
N = 0 
For Each Cell In Selection 
'1st loop - (to speed things up ignore any empty cells)
If Cell <> Empty Then 
For Each Cel In Selection 
'2nd loop - compare non-empty cel values
'and clear contents if it's a duplicated value
If Cel <> Empty And _ 
Cel.Value = Cell.Value And _ 
Cel.Address <> Cell.Address Then 
Cel.ClearContents 
N = N + 1 
End If 
Next Cel 
End If 
Next 
Application.ScreenUpdating = True 
MsgBox "There were " & N & " duplicated entries deleted" 
End Sub

for example
A B C D E F G

10	17	25	29	38	44	45
6	9	28	34	35	41	47
9	12	19	26	32	33	38
9	16	26	29	34	43	44

become

A B C D E F G

10	17	25		38		45
6		28		35	41	47
	12	19		32	33	38
9	16	26	29	34	43	44

thnx for your help and time

[SamT]

Change

For Each Cell In Selection

To

For Each Cell In Selection.Rows(Selection.Rows.Count).Row

[zouhair_psi]

thx for your reply and time

but i got error run-time error '424' object required

[p45cal]

try changing one character in your code:
Cell.ClearContents

[SamT]

My bad. Too many "Rows" above

With Selection
For each Cell In .Rows(.Rows.Count)
If Not IsEmpty(Cell) Then
For each cel In .Cells(1).Resize(.Rows.Count - 1, .Columns.Count)
If Cel = Cell Then Cel.ClearContents
Next
End If
next
End With

Faster

Dim ChkRng As Range,TestRng As Range, Cell As Range, Cel As Range 
Dim n as long

With Selection
Set ChkRng = .Rows(.Rows.Count)
Set TestRng = .Cells(1).Resize(.Rows.Count - 1, .Columns.Count)
End With

For each Cell in ChkRng
If Not IsEmpty(Cell) Then
For Each Cel in TestRng
If Cel = Cell Then Cel.ClearContents
Next
End If
next

MsgBox n

If you need more speed, use arrays

[p45cal]

SamT interpreted your requirement better than I did!

If you need more speed, use arrays

Sub DeleteDuplicateEntries2()
Dim ChkRng, TestRng As Range, TRVals, rv, rw As Long, colm As Long, n As Long

With Selection
  ChkRng = .Rows(.Rows.Count)
  Set TestRng = .Cells(1).Resize(.Rows.Count - 1, .Columns.Count)
  TRVals = TestRng.Value
End With

For Each rv In ChkRng
  If Not IsEmpty(rv) Then
    For rw = 1 To UBound(TRVals)
      For colm = 1 To UBound(TRVals, 2)
        If TRVals(rw, colm) = rv Then
          TRVals(rw, colm) = Empty
          n = n + 1
        End If
      Next
    Next
  End If
Next
TestRng = TRVals
MsgBox n
End Sub

[zouhair_psi]

thx for your time and solution

work great.

[zouhair_psi]

hi,
is posible to add a color to the deleted cells after

or Each rv In ChkRng
If Not IsEmpty(rv) Then
For rw = 1 To UBound(TRVals)
For colm = 1 To UBound(TRVals, 2)
If TRVals(rw, colm) = rv Then
TRVals(rw, colm) = Empty

i did try with cells(rw, colm).interior.color = rgb (255,0,0)

but doesn't work as i excpected

thx for your help

[p45cal]

Sub DeleteDuplicateEntries3()
Dim ChkRng, TestRng As Range, TRVals, rv, rw As Long, colm As Long, n As Long, RedRng As Range

With Selection
  ChkRng = .Rows(.Rows.Count)
  Set TestRng = .Cells(1).Resize(.Rows.Count - 1, .Columns.Count)
  TRVals = TestRng.Value
End With

For Each rv In ChkRng
  If Not IsEmpty(rv) Then
    For rw = 1 To UBound(TRVals)
      For colm = 1 To UBound(TRVals, 2)
        If TRVals(rw, colm) = rv Then
          TRVals(rw, colm) = Empty
          If RedRng Is Nothing Then Set RedRng = TestRng.Cells(rw, colm) Else Set RedRng = Union(RedRng, TestRng.Cells(rw, colm))
          n = n + 1
        End If
      Next
    Next
  End If
Next

If n > 0 Then
  TestRng = TRVals
  RedRng.Interior.Color = RGB(255, 0, 0)
End If
MsgBox n
End Sub

[zouhair_psi]

work perefect

thx for your time