INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Functions

How Can I Parse Name Components from a Full Name Field? by AlexCuse
Posted: 17 Nov 06 (Edited 22 Nov 06)

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

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close