How to remove only unique and keep duplicates

I have been trying for a day now to figure out how to remove the unique cells and keep the duplicates only. I have tried a macro but it does not seem to work. Has any one run into this before. I have attached a sample what I would like to do is remove all non-duplicates from column A. The only macro I could find was this:

Range("$A$2:$A$4344").AdvancedFilter Action:= xlFilterInPlace, Unique := True
Range("$A$2:$A$4344").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.ShowAllData

But this did not work. Any Ideas would be much appreciated.