Function UniqueLetters(Rng As Range) As String
Dim X As Long, JoinString As String
If Rng.Columns.Count > 1 Then Exit Function
JoinString = Application.Trim(Join(Application.Transpose(Rng.Value), ""))
For X = 2 To Len(JoinString)
If InStr(1, Left(JoinString, X - 1), Mid(JoinString, X, 1), vbTextCompare) Then Mid(JoinString, X) = " "
Next
UniqueLetters = UCase(Replace(Application.Trim(Replace(StrConv(JoinString, vbUnicode), Chr(0), " ")), " ", ", "))
End Function
Function UniqueLetters(Rng As Range) As String
Dim X As Long, JoinString As String, Letters() As String
If Rng.Columns.Count > 1 Then Exit Function
JoinString = Application.Trim(Join(Application.Transpose(Rng.Value), ""))
For X = 2 To Len(JoinString)
If InStr(1, Left(JoinString, X - 1), Mid(JoinString, X, 1), vbTextCompare) Then Mid(JoinString, X) = " "
Next
Letters = Split(UCase(Application.Trim(Replace(StrConv(JoinString, vbUnicode), Chr(0), " "))))
If Application.Caller.Row <= 1 + UBound(Letters) Then UniqueLetters = Letters(Application.Caller.Row - Rng(1).Row)
End Function
Function UniqueChr(r As Range, pos As Long)
Dim rCell As Range, i As Long
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each rCell In r
For i = 1 To Len(rCell)
.Item(Mid(rCell, i, 1)) = Empty
Next i
Next rCell
If pos > .Count Then
UniqueChr = ""
Else
UniqueChr = Application.Index(.keys, pos)
End If
End With
End Function