delete unique values in column

[daveyc18]

so in column D, i have unique and duplicates, but i want a macro that deletes the unique values and thus leaving only the duplicates.

the data set, just fyi, is from column A to K.

 

[DanteAmor]

Try this
Assuming your data starts in row 1

Sub Delete_Rows()
  Dim lr As Long, i As Long, a() As Variant, r As Range, rng As Range
  Application.ScreenUpdating = False
  lr = Range("D" & Rows.Count).End(xlUp).Row
  Set rng = Range("D1:D" & lr)
  Set r = Range("D" & lr + 1)
  a = rng.Value
  For i = 1 To UBound(a)
    If WorksheetFunction.CountIf(rng, a(i, 1)) = 1 Then
      Set r = Union(r, Range("A" & i))
    End If
  Next i
  r.EntireRow.Delete
End Sub