VBA Function to Split Cells Giving a Unique List

[Stephen_IV]

Good afternoon, I am looking for someone to help me update my code below. What I would like to do is get list of unique schools. Please see below. Thanks in advance.

Schools 1	Schools 2	Schools 3	Results
Jefferson School	Jefferson School, Washington School	Lincoln School, Madison School	Jefferson School, Washington School, Lincoln School, Madison School
Cleveland School, Eisenhower School, Kennedy School	Madison School, Kennedy School	Cleveland School	Cleveland School, Eisenhower School, Kennedy School, Madison School
McKinley School	Tyler School	McKinley School, Jackson School	McKinley School, Tyler School, Jackson School

Function ListUniques(r As Range) As Variant
Dim xcell As Range
Dim dic As New Dictionary
    For Each xcell In r
        If xcell.Value <> "" Then
            dic.Item(xcell.Value) = dic.Item(xcell.Value) + 1
        End If
    Next xcell
    If dic.Count > 0 Then
        ListUniques = Join(dic.Keys, ", ")
    Else
        ListUniques = CVErr(xlErrNA)
    End If
End Function
End Sub

 

[Fluff]

How about

Function ListUniques(r As Range) As Variant
   Dim xcell As Range
   Dim Sp As Variant
   Dim i As Long
   
   With CreateObject("scripting.dictionary")
      For Each xcell In r
         Sp = Split(xcell, ", ")
         For i = 0 To UBound(Sp)
            .Item(Sp(i)) = Empty
         Next i
      Next xcell
      If .Count > 0 Then
         ListUniques = Join(.Keys, ", ")
      Else
         ListUniques = CVErr(xlErrNA)
      End If
   End With
End Function

 

[Stephen_IV]

Function ListUniques(r As Range) As Variant Dim xcell As Range Dim Sp As Variant Dim i As Long With CreateObject("scripting.dictionary") For Each xcell In r Sp = Split(xcell, ", ") For i = 0 To UBound(Sp) .Item(Sp(i)) = Empty Next i Next xcell If .Count > 0 Then ListUniques = Join(.Keys, ", ") Else ListUniques = CVErr(xlErrNA) End If End With End Function

Fluff thank you so much!!!! I appreciate your help and enjoy your posts!!! Thanks again!!

 

[Fluff]

You're welcome & thanks for the feedback.