On Tue, 1 Jun 2010 17:35:39 -0600, "Jim Berglund"
wrote:

Ron Rosenfeld kindly gave me the following:

Sub ParseAddr()
Dim myRegExp As Object, myMatches As Object
Dim rg As Range, c As Range
Dim i As Long

With ActiveSheet
Range("A:A").Select
Set rg = Selection
Set myRegExp = CreateObject("vbscript.regexp")
myRegExp.Pattern = "^(\D+)\s+(.*)\s(CALGARY|MELBOURNE|SYDNEY)" &
",?\s+([A-Z]{2})\s+(\w+)\s+(\(\d{3}\)\s+\d{3}-\d{4})"

For Each c In rg
If myRegExp.test(c.Text) = True Then
Set myMatches = myRegExp.Execute(c.Text)
For i = 0 To 5
c.Offset(0, i + 1) = myMatches(0).submatches(i)
Next i
End If
Next c
End With
End Sub

It works fine against the following data, creating 5 columns with the Name,
Address, City, Prov, and Telephone Number, respectively.

ABACO CHRISTIAN P 32 PATTERSON ME SW CALGARY, AB T3H2C7 (403) 238-2039
begin_of_the_skype_highlighting (403) 238-2039
end_of_the_skype_highlighting

'Just one tweak needed...

I'd like to separate the last name from the remainder of the name (which may
be anything from "P" to "DR QUINCY R & JULIE" and create 6 columns.

Would someone (preferable Ron), please explain to me how to do this?

Thanks, once again

Jim Berglund



How do we know which name is the "last name" ?

In your earlier examples, it seemd to be the first word. If that is
the case, you can do it by modifying the Regex to split out the first
word from the rest.

Note in the following I used a somewhat different method to select the
range to parse, so as to reduce the number of cells to be processed.

======================================
Option Explicit
Sub ParseAddr()
Dim myRegExp As Object, myMatches As Object
Dim rg As Range, c As Range
Dim i As Long

Set rg = Range("A1") 'first cell in column
Set rg = Range(rg, Cells(Cells.Rows.Count, rg.Column).End(xlUp))
rg.Offset(0, 1).Resize(columnsize:=7).ClearContents

Set myRegExp = CreateObject("vbscript.regexp")
myRegExp.Pattern = _
"^(\D+?)\s(\D*)\s*(.*)\s(CALGARY|MELBOURNE|SYDNEY) ,?" _
& "\s+([A-Z]{2})\s+(\w+)\s+(\(\d{3}\)\s+\d{3}-\d{4})"

For Each c In rg
If myRegExp.test(c.Text) = True Then
Set myMatches = myRegExp.Execute(c.Text)
For i = 0 To myMatches(0).submatches.Count - 1
c.Offset(0, i + 1) = myMatches(0).submatches(i)
Next i
End If
Next c

End Sub
======================================