Function GetInitialsFromFirstPerson(ByVal names As String) As String
Dim firstPerson As String
Dim namesOnly As String
Dim initials As String
firstPerson = Trim$(Split(LCase$(names), "and")(0))
namesOnly = Trim$(Replace$(firstPerson, Split(firstPerson, " ")(0), ""))
For Each word In Split(namesOnly, " ")
initials = initials & UCase$(Left$(word, 1))
Next
GetInitialsFromFirstPerson = initials
End Function