troubleshooting Question

Need help with optimizing VBA parsing string for middle initial from several variants!

Avatar of stephenlecomptejr
stephenlecomptejrFlag for United States of America asked on
Microsoft AccessVBA
11 Comments1 Solution25 ViewsLast Modified:
Please note the following code:

Here are the test cases that work:
DEL VALLE, ADRIAN
Danielle L. Temple
ALMAGUER III, JUAN M
GREEN PINKEY, STACEY Y

Here are the test cases that do not work:
Smittick, Donesha M.
PIERCE, JR., ROBERT J
JORDAN, Savannah L.


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

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

  Dim sFullName As String
  Dim sFirst As String
  Dim sMiddle As String
  Dim i As Integer
  Dim lCountSpace As Long

  If Not IsNull(vFullName) Then
    sFullName = vFullName
    DoEvents
    
    If CommaBeforeSpace(sFullName) = True Then
      'find where , comma is
      sFullName = Trim(Right(sFullName, Len([sFullName]) - InStr([sFullName], ",")))
      'it's a first name only with a space and middle initial is:
      If Len(sFullName) > 1 And CountofCharacterInString(sFullName, " ") = 1 Then
        sMiddle = Right(sFullName, 2)
        If Left(sMiddle, 1) = " " Then
          sMiddle = Trim(sMiddle)
        Else
          sMiddle = ""
        End If
      End If
    Else
      
      sMiddle = ""
      If CountofCharacterInString(sFullName, " ") > 1 Then
        '
        lCountSpace = 0
        If OneSpaceThenPeriod(sFullName) = True Then
          For i = 1 To Len(sFullName)
            If Mid(sFullName, i, 1) = " " Then
              If Not i + 1 > Len(sFullName) Then
                sMiddle = Mid(sFullName, i + 1, 1)
                Exit For
              End If
            End If
            
          Next
          
        Else
          For i = 1 To Len(sFullName)
            If Mid(sFullName, i, 1) = " " Then
              
              lCountSpace = lCountSpace + 1
            End If
            If Mid(sFullName, i, 1) = " " And lCountSpace = 2 Then
              'find 2nd space after
              If Not i - 1 < 1 And Len(sFullName) > 2 Then
                
                sMiddle = Mid(sFullName, i - 2, 3)
                If Left(sMiddle, 1) = " " Then
                  If Right(sMiddle, 1) = " " Then
                    sMiddle = Mid(sMiddle, 2, 1)
                    Exit For
                  End If
                Else
                  sMiddle = ""
                  Exit For
                End If
                
              End If
            End If
            
            If lCountSpace > 2 Then
              Exit For
            End If
            
            If Mid(sFullName, i, 1) = "." Then
              If i <> Len(sFullName) And Mid(sFullName, i - 2, 1) = " " Then
                If Not i - 1 < 1 Then
                  
                  sMiddle = Mid(sFullName, i - 1, 1)
                  sMiddle = Trim(sMiddle)
                  Exit For
                End If
              Else
                sMiddle = ""
                Exit For
              End If
            End If
          Next
          
        End If
      
      End If
    End If
  Else
    If CountofCharacterInString(sFullName, " ") = 1 Then
      
      sMiddle = Right(sFullName, 2)
      If Left(sMiddle, 1) = " " Then
        sMiddle = Right(sFullName, 1)
      Else
        sMiddle = ""
        
      End If
      
    End If
  End If

Exit_Proc:

  If CharacterOnly(sMiddle) = False Then
    sMiddle = ""
  End If

  If sMiddle <> "" Then PullMiddleInitial = sMiddle
  Exit Function
  
Err_Proc:
  Call LogError(Err, Err.Description, "_mTasks @ PullMiddleInitial")
  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

Open in new window

ASKER CERTIFIED SOLUTION
Bembi
CEO

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Log in to continue reading
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform for $9.99/mo
View membership options
Unlock 1 Answer and 11 Comments.
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
The Value of Experts Exchange in My Daily IT Life

Experts Exchange (EE) has become my company's go-to resource to get answers. I've used EE to make decisions, solve problems and even save customers. OutagesIO has been a challenging project and... Keep reading >>

Mike

Owner of Outages.IO
Phoenix, Arizona, United States
Member Since 2016
Join a full scale community that combines the best parts of other tools into one platform.
Unlock 1 Answer and 11 Comments.
View membership options
“All of life is about relationships, and EE has made a virtual community a real community. It lifts everyone's boat.”
William Peck

Member since 2004