-
January 2nd, 2013, 04:31 PM
#1
Split Name function
Can anyone help see where I went wrong in the function below?
Code:
Function ParseOutNames(FullName As String) As Variant
Dim FirstName As String
Dim LastName As String
Dim MidInitial As String
Dim Suffix As String
Dim Pos As Integer
Dim Pos2 As Integer
Dim Pos3 As Integer
Pos = InStr(1, FullName, ",", vbTextCompare)
If Pos = 0 Then
Pos = Len(FullName) + 1
End If
LastName = Trim(Left(FullName, Pos - 1))
Pos2 = InStr(1, LastName, " ", vbTextCompare)
If Pos2 Then
Pos3 = InStr(Pos2 + 1, LastName, " ", vbTextCompare)
If Pos3 Then
Suffix = Right(LastName, Len(LastName) - Pos3)
LastName = Left(LastName, Pos3 - 1)
Else
Suffix = Right(LastName, Len(LastName) - Pos2)
LastName = Left(LastName, Pos2 - 1)
End If
End If
Pos2 = InStr(Pos + 2, FullName, " ", vbTextCompare)
If Pos2 = 0 Then
Pos2 = Len(FullName)
End If
If Pos2 > Pos Then
FirstName = Mid(FullName, Pos + 1, Pos2 - Pos)
MidInitial = Right(FullName, Len(FullName) - Pos2)
End If
Pos = InStr(1, LastName, "-", vbTextCompare)
If Pos Then
LastName = Trim(StrConv(Left(LastName, Pos), vbProperCase)) & _
Trim(StrConv(Right(LastName, Len(LastName) - Pos), vbProperCase))
Else
LastName = Trim(StrConv(LastName, vbProperCase))
End If
FirstName = Trim(StrConv(FirstName, vbProperCase))
MidInitial = Trim(StrConv(MidInitial, vbProperCase))
Suffix = Trim(StrConv(Suffix, vbProperCase))
'
' suffix handling
'
Select Case UCase(Suffix)
Case "JR", "SR", "II", "III", "IV", "MD", "PHD", "PH.D", "M.D."
Case Else
If Not IsNumeric(Left(Suffix, 1)) Then
LastName = LastName & " " & Suffix
Suffix = ""
End If
End Select
ParseOutNames = Array(LastName, FirstName, MidInitial, Suffix)
End Function
Last edited by WizBang; January 6th, 2013 at 02:08 PM.
Reason: Added [code] tags
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|