If your unique data was in column A (say A1 to A5 in your example) then you can use a variant array with a dictionary to extract the uniques
The code below
creates a variant array X with your 5 values in column A
tests each item to see if it exists in a dictionary object objDic if not it is added to the dictionary, and to a second variant array Y
the final variant array Y is dumped to B1 extending as far as necessary (this array contains the uniques plus blanks at the end in place of dupes, it can be resized if necessary)
(Updated: added test to ignore blanks*)
Sub GetUniques()
Dim X
Dim Y
Dim objDic As Object
Dim lngRow As Long
Dim lngCnt As Long
Set objDic = CreateObject("Scripting.Dictionary")
X = Range([a1], Cells(Rows.Count, "A").End(xlUp)).Value2
ReDim Y(1 To UBound(X, 1), 1 To 1)
For lngRow = 1 To UBound(X, 1)
If Len(X(lngRow, 1)) > 0 Then
If objDic.exists(X(lngRow, 1)) = False Then
lngCnt = lngCnt + 1
Y(lngCnt, 1) = X(lngRow, 1)
objDic.Add X(lngRow, 1), 1
End If
End If
Next lngRow
[b1].Resize(UBound(Y, 1), 1) = Y
End Sub
version 2
Uses Join as per Simple VBA array join not working
Sub GetUniques2()
Dim X
Dim Y
Dim objDic As Object
Dim lngRow As Long
Dim lngCnt As Long
Set objDic = CreateObject("Scripting.Dictionary")
X = Range([a1], Cells(Rows.Count, "A").End(xlUp)).Value2
ReDim Y(1 To UBound(X, 1))
For lngRow = 1 To UBound(X, 1)
If Len(X(lngRow, 1)) > 0 Then
If objDic.exists(X(lngRow, 1)) = False Then
lngCnt = lngCnt + 1
Y(lngCnt) = X(lngRow, 1)
objDic.Add X(lngRow, 1), 1
End If
End If
Next lngRow
ReDim Preserve Y(1 To lngCnt)
MsgBox Join(Y, ", ")
End Sub
