THE PARSENAME FUNCTION - EASING THE PROCESS OF DATA ENTRY

The Access Basic module listed below is designed to ease the process of field-based
data entry in an Access database.  The module has not been fully optimized in some
respects, but the core parsing algorithm is very solidly defined.  

The point of this module is to allow a data entry operator to type in part or all
of a name in a control and then call this module (specifically its primary function,
ParseName) to break the string out into parts:  Prefix, First, Middle, Last and Suffix.

Two versions of the module are listed.  The first includes minimal documentation.  The
second includes more details on the program's functionality.

To implement the module, copy it into a new Access database and then create a form with
a text control that calls the ParseName function OnEnter.  The form also needs controls
to receive the ParseName functions' results.  See the end of ParseName for proper names.

If you have any suggestions on improving this module, please let me know.  I'm going to
brush it up a bit, but I think it's good enough now to post.  I want to thank Mike Byrne
for inspiration; you may see his somewhat more sophisticated version of this algorithm on
a VB bulletin board near you at some future point.

****************************************************
****************************************************
THE PARSENAME MODULE - MINIMAL DOCUMENTATION VERSION
****************************************************

Option Compare Database   'Use database order for string comparisons
Option Explicit

Function IsItPrefix (Candidate As String)
    If InStr("MR.MS.MRS.MISS.DR.REV.", UCase$(Candidate)) Then
        IsItPrefix = True
    Else
        IsItPrefix = False
    End If
End Function

Function IsItPrefix (Candidate As String)
    If InStr("MR.MS.MRS.MISS.DR.REV.", UCase$(Candidate)) Then
        IsItPrefix = True
    Else
        IsItPrefix = False
    End If
End Function

Function RemovePunct (theName As String)
    Dim Done, Start As Integer
    Done = False
    Start = 0
    While Not Done
        If InStr(theName, ",") Then
            Start = InStr(theName, ",")
            theName = (Left$(theName, Start - 1)) & Right$(theName, (Len(theName) - Start))
        Else
            Done = True
        End If
    Wend
    RemovePunct = theName
End Function

Function RemoveSpaces (theName As String)
    Dim Done, Start As Integer
    Done = False
    While Not Done
        If InStr(theName, "  ") Then
            Start = InStr(theName, "  ")
            theName = (Left$(theName, Start - 1)) & Right$(theName, (Len(theName) - Start))
        Else
            Done = True
        End If
    Wend
    RemoveSpaces = theName
End Function

Function ParseName (theName As String)

' Declaration of variables used in program
Dim Prefix, First, Middle, Last, Suffix As String
Dim Size, i, Chunks, Pieces As Integer
Dim ExistPrefix, ExistSuffix, LeftSide, RightSide As Integer
ReDim NameArray(20) As String

' Take out leading and trailing spaces
theName = Trim(theName)

' Take out all the commas and semi-colons
theName = RemovePunct(theName)

' Take out all the double-spaces (2 spaces in  a row)
theName = RemoveSpaces(theName)

' Break string into pieces
Pieces = 1
LeftSide = 1
Size = Len(theName)
For i = 2 To Size
    If Mid$(theName, i, 1) = " " Then
        NameArray(Pieces) = Mid$(theName, LeftSide, i - LeftSide)
        LeftSide = i + 1
        Pieces = Pieces + 1
    End If
Next i
NameArray(Pieces) = Mid$(theName, LeftSide, i)

' MAIN PARSING LOOP
For Chunks = Pieces To 1 Step -1
    If IsItSuffix(NameArray(Chunks)) And Suffix = "" And Chunks = Pieces Then
        Suffix = NameArray(Chunks)
    Else
        If Last = "" Then
            Last = NameArray(Chunks)
        Else
            If Chunks >= 3 Then
                Middle = NameArray(Chunks) & " " & Middle
            Else
                If Chunks = 2 Then
                    If IsItPrefix(NameArray(1)) Then
                        First = NameArray(Chunks)
                    Else
                        Middle = NameArray(Chunks) & " " & Middle
                    End If
                Else  ' Chunks = 1
                    If IsItPrefix(NameArray(1)) Then
                        Prefix = NameArray(1)
                    Else
                        First = NameArray(1)
                    End If
                End If
            End If
        End If
    End If
Next Chunks

' Take extra space off the end of Middle
If Middle <> "" Then
    i = Len(Middle)
    Middle = Left(Middle, i - 1)
End If

' Form interaction
EndOfNewPar:
Forms!Parsomatic.Prefix = Prefix
Forms!Parsomatic.First = First
Forms!Parsomatic.Middle = Middle
Forms!Parsomatic.Last = Last
Forms!Parsomatic.Suffix = Suffix

End Function

*****************************************************
*****************************************************
THE PARSENAME MODULE - EXTENDED DOCUMENTATION VERSION
*****************************************************


Option Compare Database   'Use database order for string comparisons
Option Explicit	'Force explicit declaration of variables

' Simple function that determines whether or not a string is one of
'   several common prefixes.  If the uppercase incarnation of Candidate
'   matches with any portion of the string, IsItPrefix returns True.	
Function IsItPrefix (Candidate As String)
    If InStr("MR.MS.MRS.MISS.DR.REV.", UCase$(Candidate)) Then
        IsItPrefix = True
    Else
        IsItPrefix = False
    End If
End Function

' Simple function that determines whether or not a string is one of
'   several common suffixes.  If the uppercase incarnation of Candidate
'   matches with any portion of the string, IsItPrefix returns True.
Function IsItSuffix (Candidate As String)
    If InStr("JR.SR.IIIVMDDSI.I.I.V.", UCase$(Candidate)) Then
        IsItSuffix = True
    Else
        IsItSuffix = False
    End If
End Function

' This function removes commas from the string.  There is probably a
'   somewhat more efficient algorithm for this.
Function RemovePunct (theName As String)
    Dim Done, Start As Integer
    Done = False
    Start = 0
    While Not Done
        If InStr(theName, ",") Then
            Start = InStr(theName, ",")
            theName = (Left$(theName, Start - 1)) & Right$(theName, (Len(theName) - Start))
        Else
            Done = True
        End If
    Wend
    RemovePunct = theName
End Function

' This function works substantially like the RemovePunct function to remove superfluous
'   spaces from the name.
Function RemoveSpaces (theName As String)
    Dim Done, Start As Integer
    Done = False
    While Not Done
        If InStr(theName, "  ") Then
            Start = InStr(theName, "  ")
            theName = (Left$(theName, Start - 1)) & Right$(theName, (Len(theName) - Start))
        Else
            Done = True
        End If
    Wend
    RemoveSpaces = theName
End Function

' This is the main function.  It calls the other functions listed above.
Function ParseName (theName As String)

' Declaration of variables used in program
Dim Prefix, First, Middle, Last, Suffix As String
Dim Size, i, Chunks, Pieces As Integer
Dim ExistPrefix, ExistSuffix, LeftSide, RightSide As Integer
ReDim NameArray(20) As String

' Take out leading and trailing spaces
theName = Trim(theName)

' Take out all the commas and semi-colons
theName = RemovePunct(theName)

' Take out all the double-spaces (2 spaces in  a row)
theName = RemoveSpaces(theName)

' This chunk of code takes the prepared theName string and assigns its
'   discrete pieces to an array.  The variable Pieces counts the number of
'   distinct chunks.
Pieces = 1
LeftSide = 1
Size = Len(theName)
For i = 2 To Size
    If Mid$(theName, i, 1) = " " Then
        NameArray(Pieces) = Mid$(theName, LeftSide, i - LeftSide)
        LeftSide = i + 1
        Pieces = Pieces + 1
    End If
Next i
NameArray(Pieces) = Mid$(theName, LeftSide, i)

' MAIN PARSING LOOP
' This loop analyzes the discrete pieces of the name just assigned to the elements of
'   NameArray and assigns them accordingly.  It begins with the last assigned element.
For Chunks = Pieces To 1 Step -1
    ' The last element may be a suffix.  If it is, the If statement will return True.
    '   Note that this is only checked for the highest element assigned to the array.
    If IsItSuffix(NameArray(Chunks)) And Chunks = Pieces Then
        Suffix = NameArray(Chunks)
    ' If the element being checked is not a suffix, it could be either a last name,
    '   a middle name, a first name, or a prefix.
    Else
        ' By default, the last chunk is assumed to be last name if it is not a suffix.
        If Last = "" Then
            Last = NameArray(Chunks)
        Else
            ' If the Last name and possibly the Suffix have already been assigned,
            '   we resort to a decision structure based on our current position in
            '   the array.  Remembering that we are only here if last name has already
            '   been assigned, we know that the current element of the array will be
            '   either all or part of the middle name if Chunks >= 3.  If there is one
            '   or more middle name, it must begin with either chunk 2 (first name as
            '   chunk 1) or chunk 3 (prefix as 1, first as 2).  If there are several
            '   middle names, they are joined together by the self-referential
            '   assignment in this part of the loop.
            If Chunks >= 3 Then
                Middle = NameArray(Chunks) & " " & Middle
            Else
                ' If we are on the second element of the array (Chunks = 2), we check
                '   to see whether or not there is a prefix.  If there is, chunk 2 is
                '   assigned as the first name.
                If Chunks = 2 Then
                    If IsItPrefix(NameArray(1)) Then
                        First = NameArray(Chunks)
                    Else
                        ' If there is no prefix, chunk 2 is assigned as part or all
                        '   of the middle name.
                        Middle = NameArray(Chunks) & " " & Middle
                    End If
                Else  ' Chunks = 1
                    If IsItPrefix(NameArray(1)) Then
                        Prefix = NameArray(1)
                    Else
                        First = NameArray(1)
                    End If
                End If
            End If
        End If
    End If
Next Chunks

' Take extra space off the end of Middle
'   Our concatenation of the Middle name leaves an extra space at the end.
'   Here we remove it.
If Middle <> "" Then
    i = Len(Middle)
    Middle = Left(Middle, i - 1)
End If

' Form interaction
'   Here we assign our variables to named controls.
EndOfNewPar:
Forms!Parsomatic.Prefix = Prefix
Forms!Parsomatic.First = First
Forms!Parsomatic.Middle = Middle
Forms!Parsomatic.Last = Last
Forms!Parsomatic.Suffix = Suffix

End Function



