Kevin,
You could use the Data > Text to Columns wizard to break your column of data into 2 columns, a column with last name and then a column with first name.
Once you get it into two columns, you can use a formula like =A2&" "&B2 to concatenate first and last name.
The final step would be to copy the formula and change it to values using Edit > Copy, Edit > Paste Special > Values > OK.
Bill
Here are a couple of pieces of VBA code that do the trick. I got these off the web some time ago and have left in the "acknowledgement". This is not my code, just wish I could write code like this!!
NB: These pieces of code switch between the following formats:
FirstName LastName
LastName, FirstName
Hope this helps
Private Sub Lastname()
'David McRitchie 1999-04-09
' http://www.geocities.com/davemcritchie/excel/excel.htm
'Put cells in range from "FirstName LastName" to "LastName, FirstName"
On Error Resume Next
iRows = Selection.Rows.Count
Set lastcell = Cells.SpecialCells(xlLastCell)
mrow = lastcell.Row
If iRows > mrow Then iRows = mrow
imax = -1
For ir = 1 To iRows
checkx = Trim(Selection.Item(ir, 1))
L = Len(Trim(Selection.Item(ir, 1)))
If L < 3 Then GoTo nextrow
For im = 2 To L
If Mid(checkx, im, 1) = "," Then GoTo nextrow
If Mid(checkx, im, 1) = " " Then imax = im
Next im
If imax > 0 Then
Selection.Item(ir, 1) = Trim(Mid(checkx, _
imax, L - imax + 1)) & ", " & _
Trim(Left(checkx, imax))
End If
nextrow:
Next ir
terminated:
End Sub
Private Sub FirstName()
'David McRitchie 2000-03-23 programming
'http://www.geocities.com/davemcritchie/excel/join.htm#firstname
'Put cells in range from "LastName, FirstName" to "FirstName LastName"
Application.Calculation = xlManual
Dim cell As Range
Dim cPos As Long
For Each cell In Selection.SpecialCells(xlConstants, xlTextValues)
cPos = InStr(1, cell, ",")
If cPos > 1 Then
origcell = cell.Value
cell.Value = Trim(Mid(cell, cPos + 1)) & " " _
& Trim(Left(cell, cPos - 1))
End If
Next cell
Application.Calculation = xlAutomatic 'xlCalculationAutomatic
End Sub
If your "Last Name, First Name" is in A1 for example put this in B1 and C1 for "First Name" and "Last Name":
=RIGHT(A1,LEN(A1)-FIND("", "",A1)-1)
=LEFT(A1,LEN(A1)-LEN(B1)-2)
Juan Pablo
-----------------------