- Mar 17, 2003
- Office Version
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