Extract unique values withing a range and the results would be in one cell

Sub UnQ()
Dim Rng As Range, Dn As Range, n As Long, Sp As Variant
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
    Sp = Split(Dn.Value, ",")
    For n = 0# To UBound(Sp)
        .Item(Sp(n)) = Empty
    Next n
Next Dn
Range("A5").Value = Join(.Keys, ",")
End With

Function UnQ(rng As Range) As String
Dim Dn As Range, n As Long, Sp As Variant
    With CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
For Each Dn In rng
    Sp = Split(Dn.Value, ",")
    For n = 0# To UBound(Sp)
        .Item(Sp(n)) = Empty
    Next n
Next Dn
UnQ = Join(.Keys, ",")
End With
End Function