Extracting Middle Initial (if present)

Hi there. First time poster!
Found this forum while searching google for help.

I have a list of names first, last and sometimes middle initial. I need to separate them into 3 columns. Getting last name was easy, seperating on the comma. However I need to get Middle Initials out, where present. The problem is that some of the names on the list have 2 names like "Mary Beth", so I cant just split again on space. My sheet has 16k rows, so manually splitting is out of the question. Does anyone have an easy fix for this?
I was looking for a way to say, like, split after space if following data is 1 or 2 characters (some have periods on initial and some dont)?

For example, I need it to work with each of those:
ABBO, KATHERINE M (returns middle Initial M)
ABBOTT, DANIELLE (returns blank column)
ABE, HODAKA PAUL (returns blank column)
ABELLO, RICHARD R. (returns R.)
ABOU-HARB, JAMIL (blank)
ABRAHAM, JENNIFER VOSS (Blank)
Sorry I am an excel noob. Would greatly appreciate any help.

mehmetcik - I am sorry I am so inexperienced, but I cant get this to work. I tried pasting it in formula bar, then tried everything from just the second = onward and selecting columns B though D and it just says "false" in the first column. Got any more clues?

Hi there,

Take a look at the attached workbook and see if it does what you need. It uses the following code:

Option Explicit


Private Sub ProcessNames()

    Const sSEPARATOR    As String = " "

    Dim iNoOfColumns    As Integer
    Dim sThirdName      As String
    Dim rNewCell        As Range
    Dim vaNames         As Variant
    Dim rCell           As Range

    For Each rCell In Selection.Cells

'       Add a separator character at the end of the string
'       to ensure that the Split method works correctly
        rCell.Value = rCell.Value & sSEPARATOR

        vaNames = Split(rCell.Value, sSEPARATOR)
        iNoOfColumns = UBound(vaNames)

'       Insert the Name "components" into the adjacent cells
        With rCell.Offset(0, 1)

            Range(.Cells(1, 1), _
                  .Cells(1, iNoOfColumns)).Value = vaNames

        End With

'       Remove the comma character at the end of the surname
        Set rNewCell = rCell.Offset(0, 1)
        rNewCell.Value = Replace(rNewCell.Value, ",", vbNullString)

        Set rNewCell = rCell.Offset(0, 3)
        sThirdName = rNewCell.Value

'       Proceed only if the third "component" (initial) of the Name is non-blank
        If Len(sThirdName) > 0 Then

'           Allow a single initial followed by a full stop . . .
            If Len(sThirdName) = 2 And _
               Right$(sThirdName, 1) = "." Then

                    rNewCell.Value = sThirdName

'           . . . or else allow a single initial
            ElseIf Len(sThirdName) = 1 Then

                    rNewCell.Value = sThirdName

'           . . . but discard any third "component" which is not a single initial
            Else:   rNewCell.Value = vbNullString

            End If

        End If

    Next rCell

End Sub

Hope this helps - please let me know how you get on.

Regards,

Greg M

Hi again,

It didnt include their second first name in the first name column

Hey! That bit wasn't included in the original tech spec.!


My previous workbook has been amended to do what you want - the code used has been modified as shown below:

Option Explicit


Private Sub ProcessNames()

    Const sSEPARATOR    As String = " "

    Dim iNoOfColumns    As Integer
    Dim sThirdName      As String
    Dim rNewCell        As Range
    Dim vaNames         As Variant
    Dim rCell           As Range

    For Each rCell In Selection.Cells

'       Add a separator character at the end of the string
'       to ensure that the Split method works correctly
        rCell.Value = rCell.Value & sSEPARATOR

        vaNames = Split(rCell.Value, sSEPARATOR)
        iNoOfColumns = UBound(vaNames)

'       Insert the Name "components" into the adjacent cells
        With rCell.Offset(0, 1)

            Range(.Cells(1, 1), _
                  .Cells(1, iNoOfColumns)).Value = vaNames

        End With

'       Remove the comma character at the end of the surname
        Set rNewCell = rCell.Offset(0, 1)
        rNewCell.Value = Replace(rNewCell.Value, ",", vbNullString)

        Set rNewCell = rCell.Offset(0, 3)
        sThirdName = rNewCell.Value

'       Proceed only if the third "component" (initial) of the Name is non-blank
        If Len(sThirdName) > 0 Then

'           Allow a single initial followed by a full stop . . .
            If Len(sThirdName) = 2 And _
               Right$(sThirdName, 1) = "." Then

                    rNewCell.Value = sThirdName

'           . . . or else allow a single initial
            ElseIf Len(sThirdName) = 1 Then

                    rNewCell.Value = sThirdName

'           . . . if the third "component" is not a single initial
'           then append it to the First Name value
            Else:   rNewCell.Value = vbNullString
                    Set rNewCell = rCell.Offset(0, 2)
                    rNewCell.Value = rNewCell.Value & sSEPARATOR & sThirdName

            End If

        End If

    Next rCell

End Sub

Hope this helps - as before, please let me know how you get on.

Regards,

Greg M

Thank you both, this is just what I needed. You are absolute live savers!

Hi again,

Many thanks for your very prompt feedback.

You're welcome - glad I was able to help.

Regards,

Greg M