Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How Can I Parse Name Components from a Full Name Field?

Functions

How Can I Parse Name Components from a Full Name Field?

by  AlexCuse  Posted    (Edited  )
Yesterday I found myself needing to do some name splitting due to a changed input file layout from a vendor. Naturally, this was for one of the few systems that does not interface with our SQL Server at all, so I could not use functions I already had on there. Rather than writing convoluted queries, I decided to write a set of simple functions to help me in this task.

This is a common question, and hopefully my collection of functions can help someone with it. These are tailored to my situation, but I am sure could be altered to fit most types of 'FULLNAME' inputs that I have seen.

The functions are as follows:

fTrimPrefix - Removes prefix from name (also works for prefixes Mr. and Mrs., Dr. and Mrs.)

fTrimSuffix - Removes suffixes from name (I pass through this twice to handle for Dual Suffixes. Wanted to have it remove one at a time in order to use this function within the function to return suffixes)

fGrabFName - First passes your input through fTrimPrefix, then extracts and returns the first name.

fGrabMName - First passes your input through fTrimSuffix(twice) and fTrimPrefix, then extracts and returns middle name.

fGrabLName - First passes your input through fTrimSuffix(Twice), then extracts and returns last name.

fGrabPrefix - Extracts and returns prefix.

fGrabSuffix - Extracts and returns suffix. In some cases, passing through fTrimSuffix(once) and getting suffix1 from this value, and getting suffix2 from the original input.

These are kind of raw, and I am sure there are things that could be done to improve them (as well as suf/prefixes) that could be added to the list. I am always open to suggestions.

Hope they Help,

Alex

Note - I separated the code into blocks to make it more readable, but these are really meant to all work together. Some will work independently, some won't.


Code: 
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


Code: 
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


Code: 
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


Code: 
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


Code: 
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


Code: 
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

Code: 
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
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top