PDA

View Full Version : [SOLVED] Split First, Middle and Last Name



sg2209
01-24-2018, 11:02 PM
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
01-25-2018, 02:07 AM
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
01-25-2018, 07:06 AM
Thank you , it says Run time Error 13 Type Mismatch on Line st = Split(sn, j)

georgiboy
01-25-2018, 07:39 AM
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
01-25-2018, 08:45 AM
only a type:

st=split(sn(j,1))

sg2209
01-26-2018, 03:38 AM
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
01-26-2018, 07:23 AM
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
01-26-2018, 09:13 AM
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
01-26-2018, 09:18 AM
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
01-26-2018, 09:20 AM
Makes sense perfectly , got your points,

you are too kind , thanks

sg2209
02-03-2018, 12:21 AM
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
02-03-2018, 02:38 AM
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
02-03-2018, 05:43 AM
This one rocks , you are amazing . Thanks again :)

sg2209
02-03-2018, 07:07 AM
it keeps coping the last names (same name )to last row . Attached it the sample sheet , Could you please review

sg2209
02-03-2018, 10:15 AM
@georgiboy - please help

georgiboy
02-03-2018, 10:22 AM
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
02-04-2018, 04:42 AM
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
02-04-2018, 05:05 AM
@Georgi

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

georgiboy
02-04-2018, 06:03 AM
@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
02-04-2018, 01:04 PM
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

sg2209
02-05-2018, 09:58 PM
Thank you so much both works perfectly , appreciate your efforts .