Splitting multiple names into columns

bamagirl2002

New Member
Joined
Nov 22, 2005
Messages
2
My problem may be more of a database problem than one I can fix in Excel. I have a list of 1500 plus names that I want to split into different columns. The challenge is that these names are not simply "first [space] last"--they are all different. See below:

Jane P. Doe
Mr. and Mrs John W. Doe
Dr. and Mrs. John W. Doe
Jane Doe
Jane and John Doe

etc...

Some have periods, some do not.... so I cannot use the Data > Text to columns command, or can I?

If there were only a couple hundred, I could do a number of different split/merge commands, but with this many I would like a simpler way to accomplish my goal.

Thanks!
 

Fat Cat

Active Member
Joined
Nov 5, 2004
Messages
336
What do you want in each of your columns after the split ?

What would you want to do where you have Mr and Mrs ? just one name or create 2 names from the data ?
 

bamagirl2002

New Member
Joined
Nov 22, 2005
Messages
2
Ideally I would like to get a series of colums
1. Title (i.e. Mr. and Mrs. or Dr. and Mrs.)
2. First Name
3. Middle Initial
4. Last Name

If there were 2 names: ie Jane Doe and John Brown,

I would need 4 columns:
1. First Name 1 (Jane)
2. Last Name 1 (Doe)
3. First Name 2 (John)
4. Last Name 2 (Brown)

The reason this is so complicated is that I could have any number of name combinations...
 

PaddyD

MrExcel MVP
Joined
May 1, 2002
Messages
14,234
hi - welcome to the board!

Fairly complex sort of thing to do, but doable non-the less. frankly better suited to a vba solution than a bunch of formulas. Either way, solution would be of the form:

1) Define types of record - e.g.

Name, Name = 1
Name, Initial. Name = 2
Title and Title Name = 3
Title and Title Initial. Name = 4

2) Write something that can identify which category each record belongs to

3) Categorise the list

4) Write something that, for each category, can parse the list into components

5) Parse the list

...don't know how much of this you can do, but only you an define what the items in (1) are...can you share?
 

Fat Cat

Active Member
Joined
Nov 5, 2004
Messages
336
Here's a rather crude bit of VBA code that runs off a CommandButton placed on your worksheet. It might give you some ideas.

It will seperate out titles, first names, initials and last names, but only for the few examples you gave. It won't cope with 2 last names on the one line of text or other combinations.

It assumes your original data is on the active worksheet starting in Row 1, Column A and will send the output to "Sheet2" starting at row 2, column A

If you know VBA, away you go.
If not,
(1) from the Excel menus, choose VIEW - TOOLBARS - CONTROL TOOLBOX.
(2) once it has appeared, click on the small grey button shape (tooltip will tell you its a COMMAND BUTTON).
(3) using your mouse draw a square on the worksheet to describe the size button you want.
(4) when you have your button, double click the mouse on it and paste in the following code between the ....
Private Sub CommandButton1_Click()
and
End Sub

(5) go back to the worksheet and click on the small blue set square shape in the top left of the toolbox to switch from design mode to run mode
(6) click on the button to run the macro

Private Sub CommandButton1_Click()
Code:
Dim myText As Variant
Dim firstRow As Long
Dim lastRow As Long
Dim targetRowCounter
Dim twoNames As Boolean

Dim myData(1 To 4, 1 To 2) As String
Dim titles As Integer
Dim firstNames As Integer
Dim initials As Integer

firstRow = 1                                'first row of data to look at
lastRow = Range("A65536").End(xlUp).Row     'find last row of data
targetRowCounter = 1                        'how many rows to skip when writing out results

For i = firstRow To lastRow                 'loop thru the data
    titles = 0                              'zero the counters
    firstNames = 0
    initials = 0
    twoNames = False

    myText = Split(Cells(i, 1).Text, " ")   'split up text based on where the " " characters are
    myData(4, 1) = myText(UBound(myText))   'assume last bit of text on the line is the last name
    myText(UBound(myText)) = ""             'delete it after copying to myData array
    
    For j = 0 To UBound(myText)                     'lets see what we have left from that line of text
        Select Case Right(myText(j), 1)             'strip out any full stops
        Case "."
            myText(j) = Left(myText(j), Len(myText(j)) - 1)
        End Select
        
        Select Case myText(j)                           'look for any "and" or "&"
        Case "and", "&"
            twoNames = True
            myText(j) = ""                              'delete them once found
            
        Case "Mr", "Mrs", "Dr", "Miss", "Ms", "Fr"      'look for any titles
            titles = titles + 1
            myData(1, titles) = ""                      'zero the array first in case anything is left behind
            myData(1, titles) = myText(j)               'copy title to myData array
            myText(j) = ""                              'delete it after copying to myData array
            If titles > 1 Then twoNames = True
            
        Case Else                                       'if not a full stop or title
            If Len(myText(j)) > 1 Then                  'if length is greater than 1 assume its a name
                firstNames = firstNames + 1
                myData(2, firstNames) = ""
                myData(2, firstNames) = myText(j)
                myText(j) = ""
            Else                                        'if the length is only 1, assume its an initial
                If myText(j) <> " " And initials < 2 Then
                    initials = initials + 1
                    myData(3, initials) = ""
                    myData(3, initials) = myText(j)
                    myText(j) = ""
                Else
                    myText(j) = ""                      'we don't want more than 2 initials so delete the rest
                End If
            End If
        End Select
    Next j
    
    If twoNames = True And firstNames = 1 Then          'if we have 2 people, but only 1 first name, use the first one for both
        firstNames = 2
        myData(2, 2) = myData(2, 1)
    End If
    
                                'start writing the results out to a second worksheet
    Select Case titles
    Case 0
    Case 1
        Sheets("Sheet2").Cells(i + targetRowCounter, 1) = myData(1, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter, 4) = myData(4, 1)
    Case Else
        Sheets("Sheet2").Cells(i + targetRowCounter, 1) = myData(1, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter + 1, 1) = myData(1, 2)
        Sheets("Sheet2").Cells(i + targetRowCounter, 4) = myData(4, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter + 1, 4) = myData(4, 1)
    End Select
    
    Select Case firstNames
    Case 0
    Case 1
        Sheets("Sheet2").Cells(i + targetRowCounter, 2) = myData(2, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter, 4) = myData(4, 1)
    Case Else
        Sheets("Sheet2").Cells(i + targetRowCounter, 2) = myData(2, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter + 1, 2) = myData(2, 2)
        Sheets("Sheet2").Cells(i + targetRowCounter, 4) = myData(4, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter + 1, 4) = myData(4, 1)
    End Select
    
    Select Case initials
    Case 0
    Case 1
        Sheets("Sheet2").Cells(i + targetRowCounter, 3) = myData(3, 1)
    Case 2
        Sheets("Sheet2").Cells(i + targetRowCounter, 3) = myData(3, 1)
        Sheets("Sheet2").Cells(i + targetRowCounter + 1, 3) = myData(3, 2)
    End Select

    If titles > 1 Or firstNames > 1 Then
        targetRowCounter = targetRowCounter + 1             'need to add an extra line when 2 names are found in the one line of text
    End If
Next i
End Sub
 

Forum statistics

Threads
1,078,249
Messages
5,339,077
Members
399,276
Latest member
Donjayok

Some videos you may like

This Week's Hot Topics

Top