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
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 >>
Our community of experts have been thoroughly vetted for their expertise and industry experience.