=IFERROR(INDEX($A$2:$A$11,SMALL(IF(FREQUENCY(IF($A$2:$A$11<>"",MATCH($A$2:$A$11,$A$2:$A$11,0),""),MATCH($A$2:$A$11&"",$A$2:$A$11&"",0))>1,ROW($A$2:$A$11)-ROW($A$2)+1,""),ROWS($C$2:C2))),"")
Function AlsaqrDuplicate(rng As Range, rw As Long)
'Programming by Eslam Abdullah
Dim Content As New Collection, i&
On Error Resume Next
For i = 1 To rng.Find("*", , , , , 2).Row
If rng.Cells(i).Value <> "" And Application.CountIf(rng, rng.Cells(i)) > 1 Then _
Content.Add rng.Cells(i), CStr(rng.Cells(i))
If Content.Count = rw Then AlsaqrDuplicate = Content.Item(rw): Exit Function
Next i
AlsaqrDuplicate = ""
End Function
Sub Duplicate()
'Programming by Eslam Abdullah
Dim dic As Object, lr&, i&
Cells(2, 4).Resize(Rows.Count - 1).ClearContents
Set dic = CreateObject("Scripting.Dictionary"): dic.CompareMode = 1
lr = Cells(Rows.Count, 1).End(3).Row
For i = 2 To lr
If Not dic.Exists(Cells(i, 1).Value) And Cells(i, 1).Value <> "" And Application.CountIf(Range("A2:A" & lr), Cells(i, 1)) > 1 Then _
dic(Cells(i, 1).Value) = Cells(i, 1).Value
Next i
Cells(2, 4).Resize(dic.Count).Value = Application.Transpose(dic.Items)
End Sub