Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Public Function fTrimPrefix(InCol)
Dim OutCol As String
'replace " and " for entries containing "Mr. and Mrs."
OutCol = Replace(Replace(InCol, " and ", " "), " & ", " ")
'check for nulls
'this is only necessary when selecting case Instr value - 1
If InStr(OutCol, " ") > 1 Then
'remove first prefix if present
Select Case Left(OutCol, InStr(OutCol, " ") - 1)
Case "Miss", "Mr.", "Ms.", "Mrs.", "Dr.", "Rev.", "Capt.", "Rabbi"
OutCol = Trim(Mid(OutCol, InStr(OutCol, " ") + 1, Len(OutCol)))
Case Else
OutCol = OutCol
End Select
'remove second prefix if present
Select Case Left(Trim(OutCol), InStr(Trim(OutCol), " ") - 1)
Case "Miss", "Mr.", "Ms.", "Mrs.", "Dr.", "Rev.", "Capt.", "Rabbi"
OutCol = Trim(Mid(OutCol, InStr(Trim(OutCol), " ") + 1, Len(Trim(OutCol))))
Case Else
OutCol = OutCol
End Select
Else
OutCol = OutCol
End If
fTrimPrefix = OutCol
End Function
Public Function fTrimSuffix(InCol As String)
'I am running this twice --> fTrimSuffix(fTrimSuffix(FULLNAME))
'when I need to trim the suffix. I only want it to trim one at a time
'so that it can be used with the fGrabSuffix function in returning
'dual suffixes
Dim OutCol As String
OutCol = InCol
'Remove Suffix if present
Select Case Trim(Right(OutCol, InStr(StrReverse(OutCol), " ")))
Case "MD", "Jr.", "III", "IV", "V", "Jr", "M.D.", "DDS", "Ret.", "USN"
OutCol = Left(OutCol, Len(OutCol) - InStr(StrReverse(OutCol), " "))
'Remove Comma if present
OutCol = Replace(OutCol, ",", "")
Case Else
OutCol = OutCol
End Select
fTrimSuffix = OutCol
End Function
Public Function fGrabFName(InCol As String)
Dim OutCol As String
'first use fTrimPrefix to get a clean (left side of) name
OutCol = fTrimPrefix(InCol)
'Extract first name from cleaned name (everything up to first space)
If InStr(OutCol, " ") > 1 Then
OutCol = Left(OutCol, InStr(OutCol, " ") - 1)
End If
fGrabFName = OutCol
End Function
Public Function fGrabMName(InCol As String)
Dim OutCol As String
'first use fTrimPrefix and fTrimSuffix to get a clean name
OutCol = fTrimSuffix(fTrimSuffix(fTrimPrefix(InCol)))
'Check for a second, non-trailing space after the first to appear in string
Select Case InStr(Trim(Mid(OutCol, InStr(OutCol, " ") + 1, Len(OutCol))), " ")
'If there is one, extract middle name (between first and second spaces)
Case Is > 0
OutCol = Mid(OutCol, InStr(OutCol, " ") + 1, Len(Mid(OutCol, InStr(OutCol, " ") + 1, _
InStr(Mid(OutCol, InStr(OutCol, " ") + 1, Len(OutCol)), " "))))
'If no second space, return blank middle name
Case Else
OutCol = ""
End Select
fGrabMName = OutCol
End Function
Public Function fGrabLName(InCol As String)
Dim OutCol As String
'first use fTrimSuffix to get a clean (right side of) name
OutCol = fTrimSuffix(fTrimSuffix(InCol))
'Check for nulls
If InStr(OutCol, " ") > 1 Then
'Extract Last Name (everything after last space of cleaned name)
OutCol = Right(OutCol, InStr(StrReverse(OutCol), " ") - 1)
End If
fGrabLName = OutCol
End Function
Public Function fGrabPrefix(InCol)
Dim OutCol As String
OutCol = InCol
'Check for "Mr. and Mrs.", "Dr. and Mrs."
If Left(OutCol, 12) Like ("*r. and Mrs.") Then
OutCol = Left(OutCol, 12)
'Check for same using ampersand
ElseIf Left(OutCol, 10) Like ("*r. & Mrs.") Then
OutCol = Left(OutCol, 10)
Else
'Check for nulls
If InStr(OutCol, " ") > 0 Then
'Extract prefix if present
Select Case Left(OutCol, InStr(OutCol, " ") - 1)
Case "Miss", "Mr.", "Ms.", "Mrs.", "Dr.", "Rev.", "Capt.", "Rabbi"
OutCol = Left(OutCol, InStr(OutCol, " ") - 1)
Case Else
OutCol = ""
End Select
Else
OutCol = ""
End If
End If
fGrabPrefix = OutCol
End Function
Public Function fGrabSuffix(InCol)
Dim OutCol As String
OutCol = InCol
'Check for Nulls
If InStr(OutCol, " ") > 0 Then
'Extract Suffix if present
Select Case Trim(Right(OutCol, InStr(StrReverse(OutCol), " ")))
Case "MD", "Jr.", "III", "IV", "V", "Jr", "M.D.", "DDS"
OutCol = Right(OutCol, InStr(StrReverse(OutCol), " ") - 1)
Case "Ret", "Ret."
'uses fTrimSuffix to get 'clean' name for first suffix
OutCol = Right(Trim(fTrimSuffix(OutCol)), InStr(StrReverse(OutCol), " ") - 2) & " " & _
Right(OutCol, InStr(StrReverse(OutCol), " ") - 1)
Case Else
OutCol = ""
End Select
Else
OutCol = ""
End If
fGrabSuffix = OutCol
End Function