Thank you very much Ron!
Sorry I have not responded before, but I have been out of town and had no
'net access.
Seems to be getting close!
There is a little issue with phone nums, especailly if the address contains
a numerical street name:
Joe Doe
1259 98TH AVE
Anytown, CA 92111
(886) 123 3332
gives me the results: (note the 1259 98 after the zip)
Joe Doe 1259 98TH AVE Anytown CA 92111 1259 98 (886) 123 3332
Now if the address is a non numerical street, it works fine
Joe Doe
1259 Main AVE
Anytown, CA 92111
(886) 123 3332
Does this look like it will work properly? (it seems to, but I am not as
familiar with this addin as you are!)
=REGEX.MID(RIGHT(B2,LEN(B2) - SEARCH(I3,B2)),"[-()\d ]{7,}")
and
=REGEX.MID(RIGHT(B2,LEN(B2) - SEARCH(I3,B2)),"[-()\d ]{7,}",2)
Also, I am getting problems after I added this addin. What seems to happen
if I edit this so that I have the formula wizard (what you get when you
select the funtion from the function dropdown), I get an error that excel
has stopped responding and then it restarts. I have Excel 2007.
Bruce,
It looks as if, perhaps because my posts threaded oddly, that you are using the
original and not the revised version of the phone number extraction functions.
It should be --
H2: =REGEX.MID(A2,"(?m)^[-()\d ]{7,}$")
I2: =REGEX.MID(A2,"(?m)^[-()\d ]{7,}$",2)
Those should work.
So far as I know, the add-in has not been tested with Excel 2007, and I have
Excel 2003, so cannot check it. So I suppose you might be seeing an
incompatibility.
Similar functions to those that Longre uses can be written in VBA, if that is
an issue.
But first, see if the revised phone number functions work properly on your
data. Then we can see about translating to VBA.
--ron
Here's a VBA variant. It will parse the contents of "Selection" into the cells
to the right:
=============================================
Option Explicit
Sub ParseAdrBlock()
Dim c As Range
Const pName As String = ".*"
Const pAdr1 As String = "^[\w ]*[A-Za-z]+[\w ]*$" 'Set Multiline = True; Index
2
Const pAdr2 As String = "^[\w ]*[A-Za-z]+[\w ]*$" 'Set Multiline = True; Index
3
Const pCity As String = "^.*(?=,)" 'Set Multiline = True
Const pState As String = "[\s\S]+,\s(\S+)[\s\S]+" 'Mulitline True; Return $1;
resub
Const pZip As String = "[\s\S]+,\s(\S+)[\s\S]+" 'multiline True; resub; Return
$1
Const pPhone1 As String = "^[-()\d ]{7,}$" 'Multiline True
Const pPhone2 As String = "^[-()\d ]{7,}$" 'Multiline True; Index 2
For Each c In Selection
c.Range("B1", "I1").ClearContents
c.Offset(0, 1).Value = REMid(c.Text, pName)
c.Offset(0, 2).Value = REMid(c.Text, pAdr1, 2, , True)
c.Offset(0, 3).Value = REMid(c.Text, pAdr2, 3, , True)
c.Offset(0, 4).Value = REMid(c.Text, pCity, , , True)
c.Offset(0, 5).Value = RESub(c.Text, pState, "$1")
c.Offset(0, 6).Value = RESub(c.Text, pZip, "$1")
c.Offset(0, 7).Value = REMid(c.Text, pPhone1, , , True)
c.Offset(0, 8).Value = REMid(c.Text, pPhone2, 2, , True)
Next c
End Sub
Function RESub(str As String, SrchFor As String, ReplWith As String) As String
Dim objRegExp As RegExp
Set objRegExp = New RegExp
objRegExp.Pattern = SrchFor
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.MultiLine = True
RESub = objRegExp.Replace(str, ReplWith)
End Function
Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True, _
Optional MultiLin As Boolean = False) _
As Variant 'Variant as value may be string or array
Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection
Dim i As Long 'counter
Dim t() As String 'container for array results
' Create a regular expression object.
Set objRegExp = New RegExp
'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern
' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive
'Set global applicability.
objRegExp.Global = True
'Set multiline
objRegExp.MultiLine = MultiLin
'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then
'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.
On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
===================================
--ron
