hello,

this is a newbie question.

I have a column in excel,

ADAMS, LILLIAN ROZANN
ANDERSON, SUSAN M
ANDERSON, THOMAS J
BAANDERS, BONDIANA F
BEAN, JODY LYNN
BECKER, BETTE J
BERGSENG, ARTHUR M
BERGSENG, CAROL N


I need to parse the last name, first name and middle name(intial) in to
seperate columns.

What would be the best course of action for this?

TIA

Here's what I use . . .

Sub LastToFirst
On Error Resume Next

Dim cell as Range
Dim myRange as Variant
Dim lastCell as Variant
Dim LastFirstNames as Range

myRange = InputBox ("Enter the cell reference for hte first " & _
"cell in the column " & _
"containing the names you wish to convert. Example A1. The " & _
"names will be converted from Last First order to " & _
"First Last Order. ", "Name Conversion Software")

If myRange = "" Then
End
End If

Set myRange = Range(myRange)
myRange.Select

Set lastCell = Cells(16000, ActiveCell.Column).End(xlUp)

Set LastFirstNames = Range(Cells(2, ActiveCell.Column), lastCell)

LastFirstNames.Select

For Each cell in LastFirstNames

If Not IsEmpty(cell) Then _
ExtractValuea cell
Next

MsgBox "Names Have Succesfully Been Converted", vbOKOnly, "Name
Routine"
End Sub

Sub ExtractValue1(anyCell As Range)
Dim s As String
Dim N As Integer, i As Integer
Dim myLast As String
Dim myFirst As String

s = anyCell.Value

N = InStr(s, ",")

While N 0
i = i + 1
myLast = Left(s, N - 1)
s = Mid(s, N + 1)
anyCell.Value = s & Space(1) & myLast
SLen = Len(anyCell.Value)
anyCell.Value = Right(anyCell, SLen - 1)

N = InStr(s, ",")
Wend
i = i + 1
MsgBox "Names Have Succesfully Been Converted", vbOKOnly, "Name
Routine"
End Sub

You should be able to just copy this into a module and then run it and
it works great. However, now that I look back at this, it's kind of
clumsy and not commented. I wrote it along time ago and it works great
but I never got back to cleaning it up and putting in comments.

Here's some code to put names that are all in UPPER CASE into Proper
Case . . .

Sub ProperCaseNames

Dim PCName As Range
Dim PCNameRange As Variant
Dim lastPCName As Variant
Dim lastPCNameRange As Range

PCNameRange = InputBox("Enter the cell reference for the first " & _
"cell in the column " & _
"containing the names you wish to convert. Example A1. The " & _
"names will be converted from JOHN DOE to proper " & _
"case, John Doe. ", "Name Conversion Software")

If PCNameRange = "" Then
End
End If
Set PCNameRange = Range(PCNameRange)
PCNameRange.Select

Set lastPCName = Cells(65000, ActiveCell.Column).End(xlUp)
Set lastPCNameRange = Range(Cells(2, ActiveCell.Column), lastPCName)
lastPCNameRange.Select

For Each PCName In lastPCNameRange
IF PCName.HasFormula = False And Not IsEmpty(PCName) Then
PCName.Value = Application.Proper(PCName.Value)
End If
Next PCName
MsgBox "Names Have Succesfully Been Converted", vbOKOnly, "Name
Routine"
End Sub

I had to type all this code in because the PC where I have this stored
is not networked and so I couldn't just copy and past it in here.
Therefore, look out for any typos. I would just go ahead and past it
in and run it and of course, if there are any typos, then you'll get a
message. Please feel free to let me know if you have any problems with
any of this. I also have code that reverses the names back to Last to
First order.

Oops. I didn't ready your initial request carefully enough. I didn't
notice that you wanted the names put into 3 columns.

Here's some simple code I put together that will put the names into 3
columns. It does rely on the names being in contiguous rows. If your
column is not in row A, just change the line that says Set myvar =
Range("A2"). Also, note that I'm starting on the 2nd row assuming
you'll have a title row on row 1.

Sub FirstToLast()
Dim myvar As Variant
Dim lkforComma As Integer
Dim lkforSpace As Integer
Dim fName, mName, lName As String

Set myvar = Range("A2")
Do While Not IsEmpty(myvar)

Set nextvar = myvar.Offset(1, 0)
Set firstName = myvar.Offset(0, 1)
Set middleName = myvar.Offset(0, 2)
Set lastName = myvar.Offset(0, 3)

lkforComma = InStr(myvar, ",")
lName = Left(myvar, lkforComma - 1)
fName = Mid(myvar, lkforComma + 2)
lkforSpace = InStr(fName, Chr(32))
mName = Mid(fName, lkforSpace + 1)
fName = Mid(fName, 1, lkforSpace - 1)
firstName.Value = fName
middleName.Value = mName
lastName.Value = lName

Set myvar = nextvar
Loop
End Sub

Mr Science,

Thanks alot.

So I have 722 rows(range of A2 thru A722)
The code only did the 1st 14 rows.

TIA



"MrScience" wrote in message
ups.com...
Oops. I didn't ready your initial request carefully enough. I didn't
notice that you wanted the names put into 3 columns.

Here's some simple code I put together that will put the names into 3
columns. It does rely on the names being in contiguous rows. If your
column is not in row A, just change the line that says Set myvar =
Range("A2"). Also, note that I'm starting on the 2nd row assuming
you'll have a title row on row 1.

Sub FirstToLast()
Dim myvar As Variant
Dim lkforComma As Integer
Dim lkforSpace As Integer
Dim fName, mName, lName As String

Set myvar = Range("A2")
Do While Not IsEmpty(myvar)

Set nextvar = myvar.Offset(1, 0)
Set firstName = myvar.Offset(0, 1)
Set middleName = myvar.Offset(0, 2)
Set lastName = myvar.Offset(0, 3)

lkforComma = InStr(myvar, ",")
lName = Left(myvar, lkforComma - 1)
fName = Mid(myvar, lkforComma + 2)
lkforSpace = InStr(fName, Chr(32))
mName = Mid(fName, lkforSpace + 1)
fName = Mid(fName, 1, lkforSpace - 1)
firstName.Value = fName
middleName.Value = mName
lastName.Value = lName

Set myvar = nextvar
Loop
End Sub

Did you use the simpler code from my second example? If so, it's set
to work on contiguous rows so there can't be any blank rows because the
code will stop. You could change it so that it will work on the rows
in your range . . .

Dim myRange as Range
Dim myCell As Range
Set myRange = Range("A2:A722")

Instead of using a "Do" loop you could write . . .

For Each myCell in myRange
*** previous code goes here ****
next myCell

That should loop through all your cells but you would want to also add
a line to not process an empty cell . . .

For Each myCell in myRange
If myCell < "" Then
*** previous code goes here ***
End If
Next myCell

you don't really need a macro, but if you want, you can actually record it while
doing the steps. if the names are in column A, then a text to columns with a
space as the delimiter to get the names in the 3 columns, then a find and
replace on the comma. you can get fancier and limit the rows if you want, but i
adapted this as an example:

Sub splitnames()
With Columns("A:A")
.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)),
TrailingMinusNumbers:=True

.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
End Sub

--


Gary


"me" wrote in message
...
hello,

this is a newbie question.

I have a column in excel,

ADAMS, LILLIAN ROZANN
ANDERSON, SUSAN M
ANDERSON, THOMAS J
BAANDERS, BONDIANA F
BEAN, JODY LYNN
BECKER, BETTE J
BERGSENG, ARTHUR M
BERGSENG, CAROL N


I need to parse the last name, first name and middle name(intial) in to
seperate columns.

What would be the best course of action for this?

TIA

Mr. Science,

okay this is the code...im confused

Sub FirstToLast()
Dim myvar As Variant
Dim lkforComma As Integer
Dim lkforSpace As Integer
Dim fName, mName, lName As String

Dim myRange As Range
Dim myCell As Range
Set myRange = Range("A2:A722")

For Each myCell In myRange



Set nextvar = myvar.Offset(1, 0)
Set firstName = myvar.Offset(0, 1)
Set middleName = myvar.Offset(0, 2)
Set lastName = myvar.Offset(0, 3)

lkforComma = InStr(myvar, ",")
lName = Left(myvar, lkforComma - 1)
fName = Mid(myvar, lkforComma + 2)
lkforSpace = InStr(fName, Chr(32))
mName = Mid(fName, lkforSpace + 1)
fName = Mid(fName, 1, lkforSpace - 1)
firstName.Value = fName
middleName.Value = mName
lastName.Value = lName

Set myvar = nextvar
Next myCell

For Each myCell In myRange
If myCell < "" Then
End If
Next myCell
End Sub

There is an error
---------------------------
Microsoft Visual Basic
---------------------------
Run-time error '424':

Object required
---------------------------
OK Help
---------------------------



"MrScience" wrote in message
ups.com...
Did you use the simpler code from my second example? If so, it's set
to work on contiguous rows so there can't be any blank rows because the
code will stop. You could change it so that it will work on the rows
in your range . . .

Dim myRange as Range
Dim myCell As Range
Set myRange = Range("A2:A722")

Instead of using a "Do" loop you could write . . .

For Each myCell in myRange
*** previous code goes here ****
next myCell

That should loop through all your cells but you would want to also add
a line to not process an empty cell . . .

For Each myCell in myRange
If myCell < "" Then
*** previous code goes here ***
End If
Next myCell

Hello,

If you could use in-cell formulas for this...

This assumes that your list of names starts in cell "A1":

In cell "B1" enter:
=IF($A1<"",LEFT(A1,FIND(",",A1)-1),"")

In cell "C1" enter:
=IF($A1<"",MID(A1,(FIND(",",A1)+2),(FIND("
",A1,LEN(B1)+3))-(FIND(",",A1)+2)),"")

In cell "D1" enter:
=IF($A1<"",MID(A1,(LEN(B1)+LEN(C1))+4,LEN(A1)-(LEN(B1)+LEN(C1)+3)),"")

then fill down.

Regards,
GS

On Fri, 10 Mar 2006 19:29:36 -0800, "me" wrote:

hello,

this is a newbie question.

I have a column in excel,

ADAMS, LILLIAN ROZANN
ANDERSON, SUSAN M
ANDERSON, THOMAS J
BAANDERS, BONDIANA F
BEAN, JODY LYNN
BECKER, BETTE J
BERGSENG, ARTHUR M
BERGSENG, CAROL N


I need to parse the last name, first name and middle name(intial) in to
seperate columns.

What would be the best course of action for this?

TIA


You could select your range, then execute the:

Data/Text to Columns wizard/Delimited
and check of <space and <comma as the delimiters.

If you require a macro, you could record your steps.

If you require formulas, you could download and install Longre's free
morefunc.xll add-in from http://xcell05.free.fr

and use the following formulas:

Last: =REGEX.MID(A1,"\w+",1)
First: =REGEX.MID(A1,"\w+",2)
Middle: =REGEX.MID(A1,"\w+",3)


--ron

Okay, sorry for all the confusion. Here's the procedure we talked
about yesterday revised so that it will work whether or not there are
any blank rows. I've tested it using the data you originally supplied
and it works fine without errors. Just remember to set your range
reference to whatever you have. I've commented the line in the code
where you need to do this.

Sub FirstToLast()

Dim lkforComma As Integer
Dim lkforSpace As Integer
Dim fName, mName, lName As String
Dim myRange As Range
Dim myCell As Range

Set myRange = Range("A1:A9") 'set the range for whateve you
need

For Each myCell In myRange
If myCell < "" Then 'blank cells will be ignored

Set nextCell = myCell.Offset(1, 0)
Set firstName = myCell.Offset(0, 1)
Set middleName = myCell.Offset(0, 2)
Set lastName = myCell.Offset(0, 3)

lkforComma = InStr(myCell, ",")
lName = Left(myCell, lkforComma - 1)
fName = Mid(myCell, lkforComma + 2)
lkforSpace = InStr(fName, Chr(32))
mName = Mid(fName, lkforSpace + 1)
fName = Mid(fName, 1, lkforSpace - 1)
firstName.Value = fName
middleName.Value = mName
lastName.Value = lName

End If
Set myCell = nextCell
Next myCell

MsgBox "File Done"

End Sub