Need help with optimizing VBA parsing string for first name from several variants!

Please note the following code:

Here are the test cases that work:
Smittick, Donesha M.
Fidel I. Smith, Jr
VINCENTE, MARTINNII
ALMAGUER III, JUAN M
Rosita M. De Los Santos
BARLEY,, CARL

Here are the test cases that do not work:
PIERCE, JR., ROBERT J
PUNCH, JR., LARRY
HOPES, JR., ROOSEVELT

How may I change the below syntax to work properly or make it more succinct?

Public Function PullFirstName(vFullName As Variant) As String
On Error GoTo Err_Proc

  Dim sFullName As String
  Dim sFirst As String
  Dim bMiddle As Boolean
  Dim sMiddle As String
  Dim bSuffix As Boolean
  Dim sSuffix As String
  Dim slCase As String
  Dim i As Integer
 
  If Not IsNull(vFullName) Then
    sFullName = vFullName
    sFullName = Replace(sFullName, ".,", ",")
    sFullName = Replace(sFullName, ",,", ",")
    DoEvents
    
    If CommaBeforeSpace(sFullName) = True Then
      'process worked with UCU
      If sFullName Like "*,*" Then
        'find where , comma is
        sFullName = Trim(Right(sFullName, Len([sFullName]) - InStr([sFullName], ",")))
      End If
      'it's a first name only with a space and middle initial is:
      slCase = LCase(sFullName)
      If Len(slCase) > 2 Then
        If Right(slCase, 3) = "iii" Or Right(slCase, 3) = "jr." Or Right(slCase, 3) = "sr." Then
          bSuffix = True
          sSuffix = Right(sFullName, 3)
        Else
          If Right(slCase, 2) = "jr" Or Right(slCase, 2) = "sr" Or Right(slCase, 2) = "iv" Or Right(slCase, 2) = "ii" Then
            bSuffix = True
            sSuffix = Right(sFullName, 2)
          End If
        End If
      End If
      If Len(slCase) = 2 Then
        If Right(slCase, 2) = "jr" Or Right(slCase, 2) = "sr" Or Right(slCase, 2) = "iv" Or Right(slCase, 2) = "ii" Then
          bSuffix = True
          sSuffix = Right(sFullName, 2)
        End If
      End If
      'it's a first name only with a space and middle initial is:
      If Len(sFullName) > 1 And sFullName Like "* *" Then
        bMiddle = True
        sMiddle = Right(sFullName, 2)
        If Left(sMiddle, 1) = " " Then
          sFullName = Left(sFullName, Len(sFullName) - 2)
        Else
          sMiddle = ""
        End If
      End If
      If bSuffix = True Then
        sFullName = Left(sFullName, Len(sFullName) - Len(sSuffix))
        If sFullName = sSuffix Then
          sFullName = vFullName
        End If
      End If
      
      sFullName = Trim(sFullName)
      If sFullName Like "* *" Then
        '
        For i = 1 To Len(sFullName)
          If Mid(sFullName, i, 1) = " " And CountofCharacterInString(sFullName, " ") = 1 Then
            sFullName = Left(sFullName, i - 1)
            Exit For
          End If
        Next
      End If
      sFullName = Trim(sFullName)
      If sFullName <> "" And CountofCharacterInString(sFullName, " ") > 1 Then
        sFullName = ""
      End If
      
    End If
    If sFullName = "" Or CountofCharacterInString(sFullName, " ") > 0 Then
      sFullName = vFullName
      '
      'assume first space determines first name if normal format.
      For i = 1 To Len(sFullName)
        If Mid(sFullName, i, 1) = " " Then
          sFullName = Left(sFullName, i - 1)
          Exit For
        End If
      Next
    End If
    sFullName = Trim(sFullName)
  End If
  
  If CharacterOnly(Right(sFullName, 1)) = False Then
    sFullName = Left(sFullName, Len(sFullName) - 1)
  End If
  
  If CountofCharacterInString(sFullName, " ") = 1 Then
    slCase = LCase(sFullName)
    If Len(slCase) > 3 Then
      If Right(slCase, 4) = " iii" Or Right(slCase, 4) = " jr." Or Right(slCase, 4) = " sr." Then
        bSuffix = True
        sSuffix = Right(sFullName, 3)
      Else
        If Right(slCase, 3) = " jr" Or Right(slCase, 3) = " sr" Or Right(slCase, 3) = " iv" Or Right(slCase, 3) = " ii" Then
          bSuffix = True
          sSuffix = Right(sFullName, 2)
        End If
      End If
    End If
    If Len(slCase) = 2 Then
      If Right(slCase, 2) = "jr" Or Right(slCase, 2) = "sr" Or Right(slCase, 2) = "iv" Or Right(slCase, 2) = "ii" Then
        bSuffix = True
        sSuffix = Right(sFullName, 2)
      End If
    End If
    If Len(slCase) = 3 Then
      If Right(slCase, 3) = " jr" Or Right(slCase, 3) = " sr" Or Right(slCase, 3) = " iv" Or Right(slCase, 3) = " ii" Then
        bSuffix = True
        sSuffix = Right(sFullName, 2)
      End If
    End If
    
    If bSuffix = True Then
      sFullName = Replace(sFullName, sSuffix, "")
      sFullName = Trim(sFullName)
      
    End If
    
  End If
  
  If CountofCharacterInString(sFullName, " ") = 1 Then
      
    sMiddle = Right(sFullName, 2)
    If Left(sMiddle, 1) = " " Then
      sMiddle = Right(sFullName, 1)
    Else
      sMiddle = ""
      
    End If
    
    sFullName = Replace(sFullName, sMiddle, "")
    sFullName = Trim(sFullName)
    
  End If
   
Exit_Proc:

  If sFullName <> "" Then
    PullFirstName = sFullName
  End If
  Exit Function
  
Err_Proc:
  Call LogError(Err, Err.Description, "_mTasks @ PullFirstName")
  Resume Exit_Proc
  
End Function 

Public Function CountofCharacterInString(sValue As String, sCharacter As String) As Long
On Error GoTo Err_Proc

  Dim lCount As Long
  lCount = Len(sValue) - Len(Replace(sValue, sCharacter, ""))
  
Exit_Proc:
  CountofCharacterInString = lCount
  Exit Function
  
Err_Proc:
  Call LogError(Err, Err.Description, "_mTasks @ CountofCharacterInString")
  Resume Exit_Proc

End Function

Select allOpen in new window