Matthew,
Here is a code solution.
Sub SortByLastName()
Dim rng As Range
Dim i As Long
Dim istart As Long
Dim iTarget As Long
Dim iExtra As Long
Set rng = Range("A1:J14")
iExtra = rng.Column + rng.Columns.Count
iTarget = iExtra
istart = 2 'change to 1 if no header row
Columns(iExtra).Insert
For i = istart To rng.Rows.Count
rng(i, iTarget).Value = LastName(rng(i, 1).Value)
Next
rng.Sort key1:=Cells(iExtra, istart), header:=IIf(istart = 1, 2, 1)
Columns(iExtra).EntireColumn.Delete
End Sub
'---------------------------------------------------------------------
Private Function LastName(nme As String)
'---------------------------------------------------------------------
' Function: Return just the last name from supplied name
'---------------------------------------------------------------------
Dim sREgExp As String
sREgExp = "\b([a-z]+
+)*(O'|Mc|Mac)?[A-Z](\w+\S?)*(-[A-Z](\w+\S?)*)?\b(?=((
+)(Sr\.?|Jr\.?|[IVX][IVX]*))|,|\s*$)"
LastName = GetSubString(nme, sREgExp)
End Function
'---------------------------------------------------------------------
Private Function GetSubString(str As String, sReg As String) As String
'---------------------------------------------------------------------
' Function: Use Reg Exp to get a substring
'---------------------------------------------------------------------
Dim oRegExp As Object, M As Object
Set oRegExp = CreateObject("VBScript.RegExp")
oRegExp.Pattern = sReg
oRegExp.Global = True
Set M = oRegExp.Execute(str)
GetSubString = IIf(M.Count > 0, M(0).Value, "")
End Function
ot could be done by just adding the last 2 functions, and adding a helper
column, in put =LastNamed(A1) in that coilumn, and sort by that column
--
HTH
Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)