triton189
New Member
Joined: 21 Nov 2007
Posts: 1
Location: Blaine, MN
|
 Posted: Mon Apr 14, 2008 12:59 pm Post subject: Parse Name Components from a Full Name Field |
 |
|
I found these functions to be usefull, they allow you to split or parse a name into its component parts.
Name must be in this format: Mr. John H. Doe, DDS (can be missing some parts)
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.
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 |
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
