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

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:

CodePudding user response：

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, ",")

=UniqueItems(A1:A100, ",", FALSE)

To return a vertical array . . .

=UniqueItems(A1:A100, ",", TRUE)