Split Name function

[dpuguy]

Can anyone help see where I went wrong in the function below?

Function ParseOutNames(FullName As String) As Variant

Dim FirstName As String
Dim LastName As String
Dim MidInitial As String
Dim Suffix As String
Dim Pos As Integer
Dim Pos2 As Integer
Dim Pos3 As Integer

Pos = InStr(1, FullName, ",", vbTextCompare)
If Pos = 0 Then
    Pos = Len(FullName) + 1
End If
LastName = Trim(Left(FullName, Pos - 1))

Pos2 = InStr(1, LastName, " ", vbTextCompare)
If Pos2 Then
    Pos3 = InStr(Pos2 + 1, LastName, " ", vbTextCompare)
    If Pos3 Then
        Suffix = Right(LastName, Len(LastName) - Pos3)
        LastName = Left(LastName, Pos3 - 1)
    Else
        Suffix = Right(LastName, Len(LastName) - Pos2)
        LastName = Left(LastName, Pos2 - 1)
    End If
End If

Pos2 = InStr(Pos + 2, FullName, " ", vbTextCompare)
If Pos2 = 0 Then
    Pos2 = Len(FullName)
End If

If Pos2 > Pos Then
    FirstName = Mid(FullName, Pos + 1, Pos2 - Pos)
    MidInitial = Right(FullName, Len(FullName) - Pos2)
End If

Pos = InStr(1, LastName, "-", vbTextCompare)
If Pos Then
    LastName = Trim(StrConv(Left(LastName, Pos), vbProperCase)) & _
    Trim(StrConv(Right(LastName, Len(LastName) - Pos), vbProperCase))
Else
    LastName = Trim(StrConv(LastName, vbProperCase))
End If

FirstName = Trim(StrConv(FirstName, vbProperCase))
MidInitial = Trim(StrConv(MidInitial, vbProperCase))
Suffix = Trim(StrConv(Suffix, vbProperCase))
'
' suffix handling
'
Select Case UCase(Suffix)
    Case "JR", "SR", "II", "III", "IV", "MD", "PHD", "PH.D", "M.D."

    Case Else
        If Not IsNumeric(Left(Suffix, 1)) Then
            LastName = LastName & " " & Suffix
            Suffix = ""
        End If
End Select

ParseOutNames = Array(LastName, FirstName, MidInitial, Suffix)

End Function