Solved

Parsing -  YUK!  1 Name field into 3

Posted on 2002-05-02
19
164 Views
Last Modified: 2010-05-02
I need to parse a name field into a more up-to-date format into a Prefix, firstname, and lastname.  The information is currently in an ACCESS table with only ONE NAME FIELD having data as such.

Mr. Michael R. Smith
Dr. E Ralph
Ms. Edith Campbell
Col. Ronald McDonald
Capt Amnezia
R. A. R. Front
A. Moth
Mrs. Betz
(The_Company_Name)

I need it parsed into 3 different fields to show as follows:

"Mr.","Michael R.","Smith"
"Ms.","Edit","Campbell"
"Col.","Ronald","McDonald"
"Capt.","Amnezia"
"","R. A. R.","Front"
"","A.","Moth"
"Mrs.","Betz"
"","","The Company Name"


Which Means
1) It needs to know what prefixes are Mr. Mrs. Miss Ms., Capt., Col., Rev., (this is the list)

2)  It needs to include first and/or middle initials in the firstname field.

3) The company name usually has no spaces in it (thus the underscore) so the brackets need to be deleted (if they exist in the field) and the underscores replaced with spaces (I can do this part I think)

It's quite a bit of logic here.. Not sure how or where to start.

I am outputting it to a text file so that somebody else's program can bring it in.


Open "C:\temp\namelist.txt" For Output As #intnumfile

With Data1.Recordset
 Do Until .EOF


I get lost at this point


At the end there are other parts of the file that I have already parsed and added to the line below:

Print #intnumfile, Chr$(34) & "3" & Chr$(34); "," &  ----- etc, etc.

0
Comment
Question by:trudymaresch
  • 7
  • 6
  • 3
  • +2
19 Comments
 
LVL 4

Expert Comment

by:gencross
Comment Utility
Here is a function that I wrote to handle something like this, except I only needed the Last name, first initial.  I tested it with a format that you will need and it does not work, but you can see the logic and modify it.  I don't know of an easy way to do this, but this could be a good starting point for you.  Hope it helps.

Private Sub ParseSignature(strSig As String, sretFirstInt As String, sretLastName As String, Optional bReverse As Boolean)
   
    Dim intSpacePos As Integer
    Dim sTemp As String
    Dim sTemp2 As String
    Dim sRevLast As String
   
    On Error GoTo ParseSignature_Error
   
    'Get last name
    intSpacePos = InStr(1, strSig, " ")
    sTemp = strSig
    If intSpacePos > 0 Then
       
        'If InStr(strSig, ",") Then
        '    sretFirstInt = Trim(Mid(strSig, InStr(strSig, ",") + 1, 1))
        'End If
       
        If intSpacePos = 2 Then
            sretFirstInt = Left(strSig, 1)
            sTemp = Trim(Mid(strSig, intSpacePos + 1))
            intSpacePos = InStr(1, sTemp, " ")
            sTemp = Trim(Mid(sTemp, intSpacePos + 1))
           
            If InStr(sTemp, " ") Then
                sretLastName = Trim(Mid(sTemp, 1, InStr(sTemp, " ") - 1))
            Else
                sretLastName = sTemp
            End If
           
            Exit Sub
        Else
           
            sretFirstInt = Left(sTemp, 1)
            sRevLast = Left(sTemp, InStr(sTemp, " ") - 1)
           
            sTemp2 = Trim(Mid(sTemp, intSpacePos + 1))
           
            If InStr(sTemp2, " ") = 2 Then
                sTemp = Trim(Mid(sTemp2, InStr(sTemp2, " ") + 1))
                If InStr(sTemp, " ") = 0 Then
                    sretLastName = Trim(sTemp)
                Else
                    sretLastName = Trim(Left(sTemp, InStr(sTemp, " ") - 1))
                End If
            ElseIf InStr(sTemp2, " ") = 0 Then
                sretLastName = sTemp2
                Exit Sub
            Else
                sTemp = Trim(Mid(sTemp2, InStr(sTemp2, " ") + 1))
               
                If InStr(sTemp, " ") <> 0 Then
                    sretLastName = Trim(Left(sTemp, InStr(sTemp, " ") - 1))
                Else
                    sretLastName = sTemp
                    Select Case Left(sTemp2, 2)
                        Case "MD", "DC"
                            sretLastName = sTemp
                        Case Else
                            sretLastName = Trim(Left(sTemp2, InStr(sTemp2, " ") - 1))
                    End Select
                End If
            End If
            'Exit Sub
        End If
       
        If InStr(sretFirstInt, " ") > 0 Then
            sTemp = Mid(sretFirstInt, InStr(sretFirstInt, " ") + 1)
            If Len(sTemp2) = 1 Then
                 sretFirstInt = Left(sretFirstInt, 1)
            End If
        Else
            sretFirstInt = Left(sretFirstInt, 1)
        End If
       
    Else            'no spaces found
       sretLastName = strSig
    End If
   
    If bReverse Then
        sTemp = sretLastName
        sretLastName = sRevLast
        sretFirstInt = Left(sTemp, 1)
    End If
   
ParseSignature_Exit:
   
    Exit Sub
   
ParseSignature_Error:
   
    Resume ParseSignature_Exit
    MsgBox Err.Description, vbCritical, "ParseSignature"
    Resume
   
End Sub
0
 
LVL 4

Expert Comment

by:gencross
Comment Utility
Another Note. This function will return M Smith if it is passed for example "Michael R Smith".  You could just as some logic for the title and expand it to return the entire full name and middle init.
0
 

Author Comment

by:trudymaresch
Comment Utility
- wow that was fast! I'll have a look. - Thanks
0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
some sample code, not tested... i'm going to do that now

Dim arrPrefix(7) as String
Dim arrNames() as String
Dim newName(3) as String
Dim blnFoundPrefix as Boolean

arrPrefix(0) = "Mr."
arrPrefix(0) = "Mrs."
arrPrefix(0) = "Miss"
arrPrefix(0) = "Ms."
arrPrefix(0) = "Capt."
arrPrefix(0) = "Col."
arrPrefix(0) = "Rev."

newName(0) = Chr$(34) & Chr$(34)
newName(1) = Chr$(34) & Chr$(34)
newName(2) = Chr$(34) & Chr$(34)

arrNames = Split(strText)

   if i = 0 then '' check if it's a prefix
        blnFoundPrefix = false
        for j = 0 to UBound(arrPrefix)
            if arrPrefix(j) = arrNames(i) then
                 blnFoundPrefix = true
                 newName(0) = arrNames(i)
                 exit for
            end if
        next
        if blnFoundPrefix <> true then '' not a prefix
            '' find out how many words there were
            if UBound(arrNames) = 1 then '' it's alone so
                 newName(2) = Chr$(34) & arrNames(i) & Chr$(34)
            else if UBound(arrNames) = 2 then '' it's a first and last name
                 newName(1) = Chr$(34) & arrNames(0) & Chr$(34)
                 newName(2) = Chr$(34) & arrNames(1) & Chr$(34)
            end if
        end if

'' set up the output string
strNewName = newName(0) & "," & newName(1) & "," & newName(2)

Print #intnumfile, strNewName
                 

                             
0
 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
>It's quite a bit of logic here.. Not sure how or where to start.

As pointed out by bobbit31, I think you should start by concentrating your efforts on splitting the entries into space-delimited fields.  From there, check each field to determine the format.

For example, if the first field is the only field, it may be a company.  (Could it be anything else?)

Otherwise, check to see if it's a title.  If so, throw it into a title area.

Of the remainder, the last field should be the last name, if that's not the only field remaining, the first field is the first name, and any middle field(s) are the middle names.

--
Basically, categorize the parts and drop them into the right "buckets".  Start with the simplest option (single-field means company) and as you eliminate those, what remains is easier to deal with.
0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
btw, disregard my previous post, i'm working on a new one and actually testing it this time ;) almost got it
0
 
LVL 18

Accepted Solution

by:
bobbit31 earned 250 total points
Comment Utility
try this:

Private Sub Command1_Click()

    MsgBox parseName("Mr. Michael R. Smith")
    MsgBox parseName("Dr. E Ralph")
    MsgBox parseName("Ms. Edith Campbell")
    MsgBox parseName("Col. Ronald McDonald")
    MsgBox parseName("R. A. R. Front")
    MsgBox parseName("The_Company_Name")
    MsgBox parseName("Mrs. Betz")

End Sub

Private Function parseName(strName As String) As String

Dim arrNames() As String
Dim arrPrefix(7) As String
Dim newName(3) As String
Dim blnFoundPrefix As Boolean

arrPrefix(0) = "Mr."
arrPrefix(1) = "Mrs."
arrPrefix(2) = "Miss"
arrPrefix(3) = "Ms."
arrPrefix(4) = "Capt."
arrPrefix(5) = "Col."
arrPrefix(6) = "Rev."
arrPrefix(7) = "Dr."

newName(0) = ""
newName(1) = ""
newName(2) = ""

arrNames = Split(strName)

numWords = UBound(arrNames) + 1

Select Case numWords
   
    Case 1: '' only one word, only one option (put in third position)
        newName(0) = Chr$(34) & Chr$(34) & ","
        newName(1) = Chr$(34) & Chr$(34) & ","
        newName(2) = Chr$(34) & arrNames(0) & Chr$(34)
       
    Case 2: '' two words, two options
        '' check if there's a prefix
        blnFoundPrefix = False
        For i = 0 To UBound(arrPrefix)
            If arrNames(0) = arrPrefix(i) Then
                blnFoundPrefix = True
                Exit For
            End If
        Next
       
        If blnFoundPrefix Then
            newName(0) = Chr$(34) & arrNames(0) & Chr$(34) & ","
            newName(1) = Chr$(34) & arrNames(1) & Chr$(34)
        Else
            newName(0) = Chr$(34) & Chr$(34) & ","
            newName(1) = Chr$(34) & arrNames(0) & Chr$(34) & ","
            newName(2) = Chr$(34) & arrNames(1) & Chr$(34)
        End If
       
    Case Else: '' three or more, so check for initials
        '' check if there's a prefix
        blnFoundPrefix = False
        For i = 0 To UBound(arrPrefix)
            If arrNames(0) = arrPrefix(i) Then
                blnFoundPrefix = True
                Exit For
            End If
        Next
       
        newName(1) = Chr$(34)
        If blnFoundPrefix Then
            newName(0) = Chr$(34) & arrNames(0) & Chr$(34) & ","
        Else
            newName(0) = Chr$(34) & Chr$(34) & ","
            newName(1) = newName(1) & arrNames(0)
        End If
       
        '' basically add everything in the middle to first name
        '' when we get to the last word, we have the last name and we are
        '' done.  Assuming that there is always a last name. if not let me know
        numWords = numWords - 1 '' i added 1 earlier
        For j = 1 To numWords
            If j = numWords Then '' it's the last one, must be last name?
                newName(2) = Chr$(34) & arrNames(j) & Chr$(34)
            Else
                newName(1) = newName(1) & " " & arrNames(j)
            End If
        Next
        newName(1) = newName(1) & Chr$(34) & ","
       
End Select

'' set up the output string
For i = 0 To UBound(newName)
    If newName(i) <> "" Then
        strNewName = strNewName & newName(i)
    End If
Next
parseName = strNewName

End Function

it does make some assumptions (which i put in comments)
let me know if you need tweaking (which you probably will).

0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
also, shouldn't "Mrs. Betz" parse out to "Mrs.", "", "Betz"

if so, you can remove the Case 2
0
 

Author Comment

by:trudymaresch
Comment Utility
You are currect about the Parsing on Mrs. Betz - sorry about that typo.

Thanks
I'll remove case 2
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
As I look further at your results, I see that the logic is actually pretty simply:

1) Split the name at the spaces
2) Pull off the last item and place into the third field (modifying as necessary if it's a company)
3) Pull off the first item and see if it matches a predefined title.
a) If so, place into the first field and put the rest (joined) into the second field
b) If not, place it with the rest (joined) into the second field.
0
 

Author Comment

by:trudymaresch
Comment Utility
rspahitz
Basically - that is it in a nutshell - I tried splitting at the spaces and kept getting duplication in the parse.

bobbit31 - I took out case 2 and got an error.  
0
 

Author Comment

by:trudymaresch
Comment Utility
bobbit31 - disregard last message - fixed my error
0
 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
bobbit's code looks good...just one suggestion is to replace all chr$(34) with vbDoubleQuote and define it at the top of the sub as:

Const vbDoubleQuote as string * 1 = """"
0
 

Author Comment

by:trudymaresch
Comment Utility
Hi Bobbit - works great -except there is a blank space showing up before the first name... (except in the case of R. A. R. Front)

I'm trying to figure out why - any help would be appreciated.
0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
replace newName(1) = newName(1) & " " & arrNames(j)

with          

                If j = 1 Then
                    newName(1) = newName(1) & arrNames(j)
                Else
                    newName(1) = newName(1) & " " & arrNames(j)
                End If
0
 

Author Comment

by:trudymaresch
Comment Utility
I think it is working - now to try to import it into the other program - here goes

Thanks for all your help I think I will be awarding points shortly.
0
 
LVL 18

Expert Comment

by:bobbit31
Comment Utility
glad to help!
0
 
LVL 100

Expert Comment

by:mlmcc
Comment Utility
listening
0
 

Author Comment

by:trudymaresch
Comment Utility
Thank you! It works beautifully.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now