Doppelte löschen oben nach unten

Question

Hallo, kann mir jemand die folgende Sub umbauen, dass diese die
doppelten von oben nach unten löscht/leert?

Sub Gleiche_Loeschen_SpalteA_Protokoll_Feierabend()
'Range("D1").Value = "Text"
Sheets("Protokoll").Activate
Dim i As Long
Dim lngLastR As Long

lngLastR = Cells(Rows.Count, "A").End(xlUp).Row + 1

'Zellinhalte in Spalte F durch "" = Leerzelle ersetzen
Do
i = i + 1
Range(Cells(i + 1, "A"), Cells(lngLastR, "A")).Replace _
what:=Cells(i, "A").Value, replacement:="", lookat:=xlWhole
Loop While WorksheetFunction.CountIf(Range(Cells(i + 1, "A"),
Cells(lngLastR, "A")), "") < (lngLastR - i)

'Zeilen löschen, die Leerezellen in Spalte F haben:
On Error Resume Next
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Cells(1, 1) = Range("A65536").End(xlUp).Row
Sheets("Hauptseite").Activate
End Sub

LG Sweni

Answer 1

Sofern es zuviel Arbeit macht den Code umzuschreiben, vielleicht hat
jemand nen Duplicatefinder, der die unteren doppelten (neueren) drin
lässt und die oberen löscht?

Answer 2

Hallo Sweni,

wenn Du eine Beispieldatei online stellen und nach hier verlinken könntest, bräuchte man diese nicht nachzubauen, wozu nicht jeder Lust und Zeit hat.

Gruß
Rainer

Answer 3

hab das Problem schon anders gelöst, indem ich die Spalte vorher
einfach Z -> A sortieren lasse (erweitert auf die nebenstehenden) und
dann Doppelte lösche. Von oben nach unten soll auch lt. diversen
Foren nicht ohne sein ;-)

LG und Danke trotzdem Sweni