delete all except the last duplicate

[asddsa88]

Hello, I have a column with some names.

I am looking for a macro that finds all the duplicates and appends some text to their cell value, but I want to leave the last duplicate unchanged...

example:

COLUMN A:

scott
mary
scott
scott


macro executed--->column A now is

scott "appended text"
mary
scott "appended text"
scott

note that the last scott is unchanged!

I was thinking to use conditional formatting, but I don't know how to tell excel that he needs to keep the last duplicate unchanged..
Range("A1:A9").Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=COUNTIF(a:a;a1)>1"
Selection.FormatConditions(1).ActiveCell.Value="appended text" & ActiveCell.Value

[Bob Phillips]

Sub AppendedText()
Dim LastRow As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow

If Application.CountIf(.Cells(i, "A").Resize(LastRow - i + 1), .Cells(i, "A").Value2) > 1 Then

.Cells(i, "A").Value2 = .Cells(i, "A").Value2 & " appended text"
End If
Next i
End With
End Sub

[asemaan]

Hi

Can we delete the duplicates and keep the last one?

the records might have more than 2 duplicates, it may contains 4 or 5
we need to keep only the last one in the list.
can it be done??

Thanks
asemaan

[Bob Phillips]

Try



Sub DeleteDuplicates()
Dim LastRow As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If Application.CountIf(.Cells(i, "A").Resize(LastRow - i + 1), .Cells(i, "A").Value2) > 1 Then

.Rows(i).Delete
End If
Next i
End With
End Sub