Sub test()
Dim a, b, xD, T$, c, j&
Set xD = CreateObject("Scripting.Dictionary")
a = [a1]: b = [b1]
For j = 1 To Len(a)
T = UCase(Mid(a, j, 1)): xD(T) = 1
T = LCase(Mid(a, j, 1)): xD(T) = 1
Next
For j = 1 To Len(b)
T = Mid(b, j, 1): If xD(T) = 1 Then c = c & T
Next
MsgBox c
End Sub