Split First, Middle and Last Name

[sg2209]

hi Friends ,

i am new to VBA and trying to learn the VBA by going through the Forums, Videos and by recording the Macros , i have recorded the macro to split the First Name, Middle Name and Last name and Concatenate the Last,First ( in this Format).

now i am confused how can i get it convert to the last row , sometimes the data is upto Row 15000 , sometimes 18000 , i am confused with this and every time i need to specify the ranges , please help how should i change my macro to perfect VBA Coding , below is the macro that i have recorded , please help i did try by name the variables , but not succeeded

[Dim myfirstrow As Long, j As Long
Dim mylastrow As Long
'Inserting the Columns
Worksheets("Sample_testing").Range("F1").EntireColumn.Insert
Worksheets("Sample_testing").Range("G1").EntireColumn.Insert
Worksheets("Sample_testing").Range("H1").EntireColumn.Insert
Worksheets("Sample_testing").Range("I1").EntireColumn.Insert

'Getting Headers in Inserted Columns
Worksheets("Sample_testing").Range("F1").Value = "First Name"
Worksheets("Sample_testing").Range("G1").Value = "Middle Name"
Worksheets("Sample_testing").Range("H1").Value = "Last Name"
Worksheets("Sample_testing").Range("H1").Value = "Last First Name" 
myfirstrow = 1
mylastrow = 25000
Columns("E:E").Select

Columns("B:B").Select


    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],SEARCH("" "",RC[-1]))"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=MID(RC[-2], SEARCH("" "", RC[-2]) + 1, SEARCH("" "", RC[-2], SEARCH("" "", RC[-2])+1) - SEARCH("" "", RC[-2])-1)"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = _
        "=RIGHT(RC[-3],LEN(RC[-3]) - SEARCH("" "", RC[-3], SEARCH("" "", RC[-3],1)+1))"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Last,First"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-1],"","",RC[-3])"
    Range("E3").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlDown).Select
    Range("B32829:E32829").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.End(xlUp).Select
    
    Next m
    End With

[snb]

I assume the original data to reside in Column A

Sub M_snb()
   with sheets("Sample_testing")
      .Range("F1:H1")=split("First Name_Middle Name_Last Name_Last First Name","_")

      sn=.columns(1).specialcells(2).offset(1)
      redim sp(ubound(sn),3)

      for j=1 to ubound(sn)-1
        st=split(sn,j)
        sp(j-1,0)=st(0)
        sp(j-1,1)=st(1)
        sp(j-1,2)=st(2)
        sp(j-1,3)=st(2) & " " & st(1)
      next

      .cells(2,6).resize(ubound(sp),4)=sp
   end with
End Sub

[sg2209]

Thank you , it says Run time Error 13 Type Mismatch on Line st = Split(sn, j)

[georgiboy]

This might work:

Sub Name_Splitter()    
    Dim endR As Long, r As Range, v As Variant, x As Long
    endR = Range("A" & Rows.Count).End(xlUp).Row

    For Each r In Range("A2:A" & endR).Cells
        v = Split(r.Value, " ") 'looks for a space
        For x = 1 To UBound(v) + 1
            r.Offset(, x).Value = v(x - 1)
        Next x
        r.Offset(, x).Value = v(UBound(v)) & " " & v(0)
    Next r
End Sub

It shows how to add support for more than 3 names also

It will run slightly slower than snb's version though as it accesses the worksheet more often

Hope this helps

[snb]

only a type:

st=split(sn(j,1))

[sg2209]

Perfect . it worked like a charm thank you so much for your efforts

just a quick question this is based on when the data is in Column A , i just want if Data is Column S and i need to split this into to Column X Y Z , i did try by making some changes in the code you just shared however that did not work for me due to i don't have a knowledge of Ubound and LBound

[georgiboy]

Lets say your data was in column S
If you wanted your potential names to from columns W to AC then
Have your surname & First name combo in column AD then try this:

Sub Name_Splitter()    Dim endR As Long, r As Range, v As Variant, x As Long
    endR = Range("S" & Rows.Count).End(xlUp).Row
     
    For Each r In Range("S2:S" & endR).Cells
        v = Split(r.Value, " ") 'looks for a space
        For x = 1 To UBound(v) + 1
            r.Offset(, x + 3).Value = v(x - 1)
        Next x
        Range("AD" & r.Row).Value = v(UBound(v)) & " " & v(0)
    Next r
End Sub

Should be able to amend this to your needs

Hope this helps

[sg2209]

Perfect , thank you so much for all the help , i don't have a words to say thanks

what v(x - 1) this stands for here , please ?

[georgiboy]

v is a Variant holding an array
arrays start at 0 and if there are 3 items in it will go to 2, so 0 to 2 = 3 items

the x loop i created goes from 1 to ubound +1, so 1 to 3
therefore if i want to use x to refer to the array i need to subtract 1 from x as x is 1 to 3

Hope this makes sense

[sg2209]

Makes sense perfectly , got your points,

you are too kind , thanks

[sg2209]

Sorry georgiboy ,

i tried ammeding your code , it was working fine since you shared , suddenly it is giving me an error , below is the amended code , error is Type Mismatch on the highlighted line

[Sub Name_Splitter() Dim endR As Long, r As Range, v As Variant, x As Long
endR = Range("V" & Rows.Count).End(xlUp).Row

For Each r In Range("V2:V" & endR).Cells
v = Split(r.Value, " ") 'looks for a space
For x = 1 To UBound(v) + 1
r.Offset(, x + 18).Value = v(x - 1)
Next x
Range("AV" & r.Row).Value = v(UBound(v)) & ", " & v(0)
Next r
End Sub


Data is Present in Column V and there are more data in column W, X till AM , so i did it x+18 for Column AO , please suggest the changes

[georgiboy]

I would imagine it has found a cell that does not have a space, maybe one of the cells only has one name?

As you have alot of names to check anyway i would suggest skipping past the errors by adding this line before the loop:

On Error Resume Next

Like this:

Sub Name_Splitter()    
    Dim endR As Long, r As Range, v As Variant, x As Long
    endR = Range("V" & Rows.Count).End(xlUp).Row


    On Error Resume Next
    For Each r In Range("V2:V" & endR).Cells
        v = Split(r.Value, " ") 'looks for a space
        For x = 1 To UBound(v) + 1
            r.Offset(, x + 18).Value = v(x - 1)
        Next x
        Range("AV" & r.Row).Value = v(UBound(v)) & ", " & v(0)
    Next r
    
End Sub

Hope this helps

[sg2209]

This one rocks , you are amazing . Thanks again

[sg2209]

it keeps coping the last names (same name )to last row . Attached it the sample sheet , Could you please review

[sg2209]

@georgiboy - please help

[georgiboy]

I can’t at the moment, I have a family and a job.

i will have a look when I can, I can’t always access a PC.

[georgiboy]

Sub Name_Splitter()    
    Dim endR As Long, r As Range, v As Variant, x As Long
    endR = Range("V" & Rows.Count).End(xlUp).Row
        
    On Error Resume Next
    For Each r In Range("V2:V" & endR).Cells
        v = Split(r.Value, " ") 'looks for a space
        For x = 1 To UBound(v) + 1
            r.Offset(, 17 + x).Value = v(x - 1)
        Next x
        Range("AR" & r.Row).Value = v(UBound(v)) & ", " & v(0)
        v = ""
    Next r
End Sub

[snb]

@Georgi

Instead of endlessly reading/writing in a worksheeet you'd better use an array.

[georgiboy]

@snb

Would definitely be better/faster, I lean towards them if I am informed I am dealing with a lot of data.
I sometimes avoid them for people who are learning VBA as they are not easy on the eye.

when I first started learning VBA arrays were like rocket science

[snb]

Sub M_splitter() 
  For Each it in columns(22).specialcells(2) 
    sn= Split(it)
    sn(0)=sn(ubound(sn)) & ", " & sn(0)
    it.offset(,17).resize(,ubound(sn)+1)=sn
  Next 
End Sub