Sub a()
Dim CONCAT, p As Range
Application.ScreenUpdating = False
Columns(1).SpecialCells(xlCellTypeConstants, 2).Copy Range("B2")
Columns(2).RemoveDuplicates Columns:=1, Header:=xlNo
Set p = Columns(2).SpecialCells(xlCellTypeConstants, 2)
p.Sort [B2], Order1:=xlAscending, Header:=xlNo
CONCAT = Join(Application.Transpose(p.Value), ";")
p.ClearContents
MsgBox CONCAT
End Sub