Populate 1d array to rows or column with unique items - excel

Question

In my sheet, I have a column with some data and in some of the cells there are more than one item separated by comma
For example:
Ahmed
Reda, Salah
Yasser, Nader, Hany
Kamal
Nader, Ali, Ahmed
Here's the udf that extracts the unique items and populate it to a row not a column.
Function UniqueItems(ByVal rng As Range, ByVal delim As String, ByVal f As Boolean)
Dim strPart, ky, c As Range, dic As Object, temp As String
If f = True Then
Dim strArr() As String
Else
'how to make it 2d array
Dim strArr() As String
End If
Set dic = CreateObject("Scripting.Dictionary")
For Each c In rng
If c.Value <> "" Then
strArr = Split(c.Value, delim)
For Each strPart In strArr
On Error Resume Next
dic.Add Trim(strPart), Trim(strPart)
On Error GoTo 0
Next strPart
temp = ""
For Each ky In dic
temp = temp & ky & delim
Next ky
End If
Next c
Dim v
v = Split(Left(temp, Len(temp) - Len(delim)), delim)
If f = True Then
UniqueItems = Split(Left(temp, Len(temp) - Len(delim)), delim)
Else
''how to make it for column
End If
End Function
How can I add another parameter in the udf arguments to decide if the user want that list of results in a row or a column?
Another point if possible, I wanted to sort the results and I used another udf
Function SortArray(myArray As Variant, bOrder As Boolean)
Dim temp, i As Long, j As Long
For i = LBound(myArray) To UBound(myArray) - 1
For j = i + 1 To UBound(myArray)
If IIf(bOrder, UCase(Trim(Replace(myArray(i), "/", ""))) > UCase(Trim(Replace(myArray(j), "/", ""))), UCase(Trim(Replace(myArray(i), "/", ""))) < UCase(Trim(Replace(myArray(j), "/", "")))) Then
temp = myArray(j)
myArray(j) = myArray(i)
myArray(i) = temp
End If
Next j
Next i
SortArray = myArray
End Function
But the udf doesn't sort as expected
the data:
the expected:

Answer 1

I have amended your function so that the code is more concise. You'll notice that the last parameter is optional and determines whether the function returns a horizontal or vertical array.
So if no argument is passed to the function or if the argument passed is FALSE, the function returns a horizontal array. If TRUE is passed, it returns a vertical array.
Function UniqueItems(ByVal rng As Range, ByVal delim As String, Optional ByVal transpose As Boolean = False)
Dim dic As Object
Dim c As Range
Dim strArr() As String
Dim strPart As Variant
Set dic = CreateObject("Scripting.Dictionary")
For Each c In rng
If c.Value <> "" Then
strArr() = Split(c.Value, delim)
For Each strPart In strArr
dic(Trim(strPart)) = ""
Next strPart
End If
Next c
If transpose = True Then
UniqueItems = Application.transpose(dic.keys())
Else
UniqueItems = dic.keys()
End If
End Function
To return a horizontal array . . .
=UniqueItems(A1:A100, ",")
or
=UniqueItems(A1:A100, ",", FALSE)
To return a vertical array . . .
=UniqueItems(A1:A100, ",", TRUE)