Compare cells and delete

Hi,
I have a worksheet with many rows and in column D I have different values/text in each cell (no blanks). The first 20 rows have a certain value/text and the next 34 have another certain value/text and so on and so on. (i.e. 20 ab's and 34 qx's)
What I want is to only keep one of the lines for each value/text.

My thought was to compare the cell D1 with D2 and if they were the same then delete entire row of D2 and then continue with D1 and D3 and so on until the end and then continue with comparing D2 and D3...... The script I wrote was:

Sub Makro4()
a = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To a
b = i + 1
For j = b To a
If Range("D" & i).Value = Range("D" & j).Value Then
Range("D" & j).EntireRow.Delete
Else
a = Cells(Rows.Count, 1).End(xlUp).Row
End If
Next
Next
End Sub

But this script leaves 5 of each line, and I don't understand why.
Can anyone help?

If you have a better way of solving this it will be greatly appreciated. (Total number of rows is 5000)
W

Hello whitebalance,

There a several methods you can use to do this. This macro uses the Dictionary object to store only the unique entries. Any duplicates will have the entire row cleared. Afterward, the remaining data is sorted in ascending order to remove the blank rows.

Sub DeleteRepeats()

  Dim Cell As Range
  Dim DSO As Object
  Dim Key As String
  Dim Rng As Range
  Dim RngEnd As Range
  
    Set Rng = Range("D1")
    Set RngEnd = Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Range(Rng, RngEnd))
    
    Set DSO = CreateObject("Scripting.Dictionary")
    DSO.CompareMode = vbTextCompare
    
      For Each Cell In Rng
        Key = Trim(Cell.Text)
        If Not DSO.Exists(Key) Then
           DSO.Add Key, 1
        Else
           Cell.EntireRow.ClearContents
        End If
      Next Cell
      
    Rng.Sort Key1:=Rng.Cells(1, 1), Order1:=xlAscending, Header:=xlGuess, _
             MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers
    
    Set DSO = Nothing
    
End Sub