Name Sparsing...

[VisualGuy]

This is a tough one...

Does anyone know if there is an example or free utility out there that can read a Name field and sparse it based on First Name, Last Name, Middle Name or Initial, suffix (ie. Jr., Sr., II, III...)

I've searched what feels like everywhere, but all that is out there are $250+ utilities. Someone must have a great example that I could glean off of.

My boss did this years ago and basically what he did was read from the left a name such as:

Mr. Edward A Van Halen IV

When he would find a space, he would take what was last read from the left and place it in a variable. Then he would check it agains common suffixes, prefixes, etc and make his determination as which columns to place the variables in.

This might be the best or only way to do this, but even he admits that it isn't full proof.

Keep in mind, these names are all in one field. So, does anyone know of any good links, freeware, etc... that can help make this a less horrifying experience? I'm open to any suggestions.

THANK YOU.

 

[mmilan]

Have a look at the split function - it takes a delimited string and a delimiter, and returns you an array of the sections.

Your name field is effectively a delimited string delimited by spaces...

Identifiying a title could be done via common values (Mr, Mrs etc) - but remember to convert everything to upper case in the comaprison to avoid case sensitivity.

As for the IV bit, writing a function to tell you if a string only contains roman numerals should be easy enough.

Once you have these bits of information, the rest is easy - what ever lies after the title begins with a forename, has some random number of middle names, and has a surname before the IV bit (if it's there at all).

Hope that helps.

Martin

 

[LazyMe]

You should know that multiple titles usually aren't seperated by spaces (i.e: Mr.Ir. A.B. Smith). I once wrote a parsing function like this:
Private Sub ParseContact(ByVal vcurFieldIndex As Currency, ByRef rstrContact As String)

Dim intCounter As Integer, intPos As Integer, aintPos() As Integer, intInnerCounter As Integer, intTemp As Integer
Dim strContact As String, astrTitle() As String, strOrgVal As String, strGender As String, strTemp As String, strTitle As String, strMiddle As String

On Error GoTo ErrHandler

Select Case vcurFieldIndex
Case FIELD_CNT_GENDER, FIELD_CNT_INITIALS, FIELD_CNT_TITLE
intPos = InStrRev(rstrContact, ".&quot '//The last decimal point terminates the titles/initials section of the contact information.
If intPos > 0 Then '//However, one column does not provide this.
'//Filter out title stuff:
strContact = left(rstrContact, intPos)
strOrgVal = strContact

For intCounter = LBound(m_astrTitles, 1) To UBound(m_astrTitles, 1)
intPos = InStr(1, strContact, m_astrTitles(intCounter, TITLE_TITLE), vbTextCompare)

If intPos > 0 Then
'//Save position of this title:
Add2Array_Integer aintPos, InStr(1, strOrgVal, m_astrTitles(intCounter, TITLE_TITLE), vbTextCompare), False

'//Add to titles array and remove from string:
Add2Array_String astrTitle, Mid(strContact, intPos, Len(m_astrTitles(intCounter, TITLE_TITLE))), False
strContact = Trim(Replace(strContact, astrTitle(UBound(astrTitle)), "", 1, 1, vbTextCompare))

'//Save gender:
If m_astrTitles(intCounter, TITLE_GENDER) <> &quot;O&quot; Then strGender = m_astrTitles(intCounter, TITLE_GENDER)
End If
Next intCounter

If TestArray_String(astrTitle) Then
'//Set titles in correct order:
For intCounter = UBound(aintPos) - 1 To 0 Step -1
For intInnerCounter = 0 To intCounter
If aintPos(intInnerCounter) > aintPos(intInnerCounter + 1) Then
intTemp = aintPos(intInnerCounter + 1)
strTemp = astrTitle(intInnerCounter + 1)

aintPos(intInnerCounter + 1) = aintPos(intInnerCounter)
aintPos(intInnerCounter) = intTemp

astrTitle(intInnerCounter + 1) = astrTitle(intInnerCounter)
astrTitle(intInnerCounter) = strTemp
End If
Next intInnerCounter
Next intCounter

strTitle = Join(astrTitle, Chr(32))
End If

rstrContact = Trim(CStr(Switch(vcurFieldIndex = FIELD_CNT_GENDER, strGender, _
vcurFieldIndex = FIELD_CNT_TITLE, strTitle, _
vcurFieldIndex = FIELD_CNT_INITIALS, strContact)))

ElseIf vcurFieldIndex = FIELD_CNT_GENDER Then '//And in this case, we only need to parse out the gender.
For intCounter = LBound(m_astrTitles, 1) To UBound(m_astrTitles, 1)
If StrComp(m_astrTitles(intCounter, TITLE_TITLE), rstrContact, vbTextCompare) = 0 Then Exit For
Next intCounter

If intCounter <= UBound(m_astrTitles, 1) Then
rstrContact = m_astrTitles(intCounter, TITLE_GENDER)
Else
rstrContact = &quot;&quot;
End If
End If

Case FIELD_CNT_MIDDLE, FIELD_CNT_LAST
'//Start after initials:
strContact = Trim(Mid(rstrContact, InStrRev(rstrContact, &quot;.&quot + 1))

'//See if a middle name can be parsed out:
For intCounter = 1 To m_colMiddleNames.Count
If StrComp(left(strContact, Len(CStr(m_colMiddleNames.Item(intCounter) & &quot; &quot)), CStr(m_colMiddleNames.Item(intCounter) & &quot; &quot, vbTextCompare) = 0 Then
strMiddle = left(strContact, Len(CStr(m_colMiddleNames.Item(intCounter))))
strContact = Trim(Mid(strContact, Len(strMiddle) + 1))

Exit For
End If
Next intCounter

rstrContact = Trim(CStr(IIf(vcurFieldIndex = FIELD_CNT_MIDDLE, strMiddle, strContact)))
End Select

On Error GoTo 0

Exit Sub

ErrHandler:
'//Show error:
g_objApp.DoUnexpectedError &quot;clsChamberOfCommerce&quot;, &quot;ParseContact&quot;
End Sub




---------------------------------------------------------

And this is how the Arrays with middlenames and titles look. As you'll see they're far from complete (and they're strictly Dutch orientated)....

'//Fill middlenames collection with values:
Set m_colMiddleNames = New Collection

With m_colMiddleNames
.Add &quot;van het&quot;
.Add &quot;van 't&quot;
.Add &quot;van der&quot;
.Add &quot;van den&quot;
.Add &quot;van de&quot;
.Add &quot;van&quot;
.Add &quot;v/d&quot;
.Add &quot;de&quot;
.Add &quot;der&quot;
.Add &quot;den&quot;
.Add &quot;op 't&quot;
.Add &quot;op de&quot;
.Add &quot;op het&quot;
.Add &quot;in 't&quot;
.Add &quot;in het&quot;
.Add &quot;in de&quot;
.Add &quot;in den&quot;
.Add &quot;ten&quot;
.Add &quot;ter&quot;
.Add &quot;te&quot;
.Add &quot;'t&quot;
End With

'//Fill titles collection with values:
ReDim m_astrTitles(10, 1)

m_astrTitles(0, TITLE_TITLE) = &quot;MR.&quot;
m_astrTitles(0, TITLE_GENDER) = &quot;O&quot;
m_astrTitles(1, TITLE_TITLE) = &quot;DE HEER&quot;
m_astrTitles(1, TITLE_GENDER) = &quot;M&quot;
m_astrTitles(2, TITLE_TITLE) = &quot;MEVROUW&quot;
m_astrTitles(2, TITLE_GENDER) = &quot;V&quot;
m_astrTitles(3, TITLE_TITLE) = &quot;DRS.&quot;
m_astrTitles(3, TITLE_GENDER) = &quot;O&quot;
m_astrTitles(4, TITLE_TITLE) = &quot;ING.&quot;
m_astrTitles(4, TITLE_GENDER) = &quot;O&quot;
m_astrTitles(5, TITLE_TITLE) = &quot;IR.&quot;
m_astrTitles(5, TITLE_GENDER) = &quot;O&quot;
m_astrTitles(6, TITLE_TITLE) = &quot;DR.&quot;
m_astrTitles(6, TITLE_GENDER) = &quot;O&quot;
m_astrTitles(7, TITLE_TITLE) = &quot;JONKHEER&quot;
m_astrTitles(7, TITLE_GENDER) = &quot;M&quot;
m_astrTitles(8, TITLE_TITLE) = &quot;JONKVROUW&quot;
m_astrTitles(8, TITLE_GENDER) = &quot;M&quot;
m_astrTitles(9, TITLE_TITLE) = &quot;DE WELEDELGESTRENGE HEER&quot;
m_astrTitles(9, TITLE_GENDER) = &quot;M&quot;
m_astrTitles(10, TITLE_TITLE) = &quot;DE WELEDELGESTRENGE VROUW&quot;
m_astrTitles(10, TITLE_GENDER) = &quot;V&quot;

'//Fill letter headings collection with values:
ReDim m_astrHeadings(1, 1)

m_astrHeadings(0, TITLE_TITLE) = &quot;GEACHTE HEER&quot;
m_astrHeadings(0, TITLE_GENDER) = &quot;M&quot;
m_astrHeadings(1, TITLE_TITLE) = &quot;GEACHTE MEVROUW&quot;
m_astrHeadings(1, TITLE_GENDER) = &quot;V&quot;


Greetings,
Rick