rearrange first last and middle name in a cell

Hey all,

Basically I have one cell that can look like this:

IN RIGHT OF AKA PAUL A HERMAN,

And I want to have it look like this:

HERMAN PAUL A

So:

1) extract content to right of AKA
2) If comma exists at end, remove it
3) Rearrange the name so it's last, first, middle rather than first, middle, last

I have been working on this and this is what I have:

Sub Inspect()
    Dim old_str As String
    Dim new_str As String
    Dim first_name As String
    Dim last_name As String
    Dim middle_name As String
    Dim regex As Object
    Dim Rng As Range
    
    pos = InStr(Range("A1"), "AKA")
    
    If pos <> 0 Then
           old_str = Right(Range("A1"), Len(Range("A1")) - pos - 2)
    End If
    
    new_str = Left(old_str, Len(old_str) - 1)
    
    Range("B1").Value = Trim(new_str)
    
    Set Rng = Range("B1")

    Set regex = CreateObject("VBScript.RegExp")

    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "(^\w+\s\w+\s\w+)"

    If regex.Test(Range("B1").Value) Then
    
        first_name = Left(B1, Find(" ", B1) - 1)
        
        middle_name = Mid(B4, Find(" ", B4) + 1, Find(" ", B4, 1 + Find(" ", B4)) - Find(" ", B4) - 1)
    
        last_name = Right(A1, Len(A1) - Find("*", Substitute(A1, " ", "*", Len(A1) - Len(Substitute(A1, " ", "")))))
    End If
    
    Range("C1").Value = last_name & " " & first_name & " " & middle_name
End Sub

I get compiler error and it highlights the FIND function. It appears I cannot use excel formulas in a VBA script. Anyone have any solution how I can extract the first, last, and middle so I can rearrange them in my VBA function?

Thanks for response

johnmerlino,

Find is a worksheet function, so to use it in VB, it has to be prefaced with WorksheetFunction. like so:

WorksheetFunction.Find( 'Place Find function here

Hope that helps,
~tigeravatar

Thanks for response. I did as you suggested and I now get the error "Unable to get the find property of the worksheetfunction class":

Sub Inspect()
    Dim old_str As String
    Dim new_str As String
    Dim first_name As String
    Dim last_name As String
    Dim middle_name As String
    Dim regex As Object
    Dim Rng As Range
    
    pos = InStr(Range("A1"), "AKA")
    
    If pos <> 0 Then
           old_str = Right(Range("A1"), Len(Range("A1")) - pos - 2)
    End If
    
    new_str = Left(old_str, Len(old_str) - 1)
    
    Range("B1").Value = Trim(new_str)
    
    Set Rng = Range("B1")

    Set regex = CreateObject("VBScript.RegExp")

    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "(^\w+\s\w+\s\w+)"

    If regex.Test(Range("B1").Value) Then
    
        first_name = Left(B1, WorksheetFunction.Find(" ", B1) - 1)
        
        middle_name = Mid(B4, WorksheetFunction.Find(" ", B4) + 1, WorksheetFunction.Find(" ", B4, 1 + WorksheetFunction.Find(" ", B4)) - WorksheetFunction.Find(" ", B4) - 1)
    
        last_name = Right(A1, Len(A1) - WorksheetFunction.Find("*", WorksheetFunction.Substitute(A1, " ", "*", Len(A1) - Len(WorksheetFunction.Substitute(A1, " ", "")))))
    End If
    
    Range("C1").Value = last_name & " " & first_name & " " & middle_name
End Sub

The change to instr now gives me a "type mismatch" error highlighting this line:

middle_name = Mid(B4, InStr(" ", B4) + 1, InStr(" ", B4, 1 + InStr(" ", B4)) - InStr(" ", B4) - 1)

with this code:

Sub Inspect()
    Dim old_str As String
    Dim new_str As String
    Dim first_name As String
    Dim last_name As String
    Dim middle_name As String
    Dim regex As Object
    Dim Rng As Range
    Dim InitialRange As Variant
    Dim CompareRange As Variant
    Dim x As Variant
    Dim y As Variant
    ReDim KeepThese(1 To 10000)

    
    pos = InStr(Range("A1"), "AKA")
    
    If pos <> 0 Then
        old_str = Right(Range("A1"), Len(Range("A1")) - pos - 2)

        new_str = Left(old_str, Len(old_str) - 1)
    
        Range("A1").Value = Trim(new_str)
        
        Set Rng = Range("A1")

        Set regex = CreateObject("VBScript.RegExp")

        regex.Global = True
        regex.IgnoreCase = True
        regex.Pattern = "(^\w+\s\w+\s\w+)"

        If regex.Test(Range("A1").Value) Then
    
            first_name = Left(B1, InStr(" ", B1) - 1)
        
            middle_name = Mid(B4, InStr(" ", B4) + 1, InStr(" ", B4, 1 + InStr(" ", B4)) - InStr(" ", B4) - 1)
    
            last_name = Right(A1, Len(A1) - InStr("*", WorksheetFunction.Substitute(A1, " ", "*", Len(A1) - Len(WorksheetFunction.Substitute(A1, " ", "")))))
        End If
    
        Range("A1").Value = last_name & " " & first_name & " " & middle_name
    
    End If
    
    Set InitialRange = Range("A:A")
    Set CompareRange = Range("B:B")

    For Each x In InitialRange
        For Each y In CompareRange
            If x = y Then
              KeepThese = IIf(Len(x) > Len(y), x, y)
            End If
        Next y
    Next x

    For Each Key In KeepThese
        Range("C1").Value = Key
    Next Key
End Sub

Note that now I am just targeting A1, for example, but obviously I will need to change that to A1 & i because I would be iterating the length of the column. I just do this now so it makes it easier to troubleshoot.

Basically, in cell A1 I have something like this:

In property of AKA Jen S Stephen,

In cell B1, I have something like this:

Stephen Jen

So my VBA above intends to change A1 to this: Stephen Jen S and then which ever is greater length (e.g. Stephen Jen S or Stephen Jen) output it to cell C1.

Thanks for response.

Thanks a lot for all the responses

@snb, I tried your technique but it threw an error "Argument Not Optional" highlighting "Space".

@Marcol, Then I tried your technique and it worked for one cell. So I modified it a little so it loops through length of column A:

Sub test()

  Dim lngLastRow As Long
  lngLastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
     Dim FirstNames As String
    Dim n As Long
    Dim arrNames As Variant
    Dim ConstantFound As Boolean
    Const AKA = " AKA "
  Dim i

  For i = 1 To lngLastRow
  
    arrNames = Split(WorksheetFunction.Substitute(Range("A" & i), ",", ""))
    For n = LBound(arrNames) To UBound(arrNames) - 1
        If ConstantFound Then FirstNames = FirstNames & " " & arrNames(n)
        If UCase(arrNames(n)) = Trim(AKA) Then ConstantFound = True
    Next
    If ConstantFound Then Range("C" & i) = arrNames(UBound(arrNames)) & FirstNames
  Next i

End Sub

This above returns something like this:

IN RIGHT OF AKA PAUL A HERMAN	 HERMAN PAUL	HERMAN PAUL A
Benna Ann	                                 Benna Ann Mary	Ann PAUL A Benna

But rather than this:

HERMAN PAUL A
Ann PAUL A Benna

My intention was to pull the name with the longer length when comparing all of Column A and B (so it wouldn't just be comparing B1 and A1 but perhaps B3 and A2) like this:

HERMAN PAUL A
 Benna Ann Mary

It may be a minor change that fixes this, but I don't fully understand your code.

Thanks for response.

Here's actually a visual example of what I was looking for:

JENNIFER T TAMASHIRO	    TAMASHIRO,  JENNIFER
JORGE J GARCIA	            STANIC,  ZORAN
Jamie Smith	                    In honor of AKA Jamie L Smith
	
Based on above example, what I would like in column C:	
TAMASHIRO JENNIFER T	
GARCIA JORGE J	
ZORAN STANIC	
Smith Jamie L

Thanks for response.

How about posting a workbook with some sample data?

Up 'til now you have been given 5 or 6 potential solutions, based on 1 line copied from the forum, that would appear to be insufficient.
What is your last post meant to represent? Two columns of data? Remove duplicates?.......

A bit more input from you would not go amiss.

Thanks for response. I don't have worksheet right now, but I will try to put fake data. I been trying to do it on my own.