The data I am working with is a list of addresses. The numbers range
from two to four digits and the street name can be up to four words.
Unfortunately their really is no order. It is text copied from a
sheet and information doesn't line up correctly to do the text-to-
cells function. A nother alternative might be to somehow insert maybe
20 spaces before the second set of numbers so that i may use the text-
to-cells function in excel.
123 Main Street 471 South West Street
1234 Twenty First Ave 34 North Blvd
You can do it with a User Defined Function (UDF) or with a Macro.
A UDF that will accomplish this is below.
To enter the UDF, <alt-F11> opens the VB Editor. Ensure your project is
highlighted in the Project Explorer window, then Insert/Module and paste the
code below into the window that opens.
To use this UDF, enter the function:
=SepAdr(cell_ref,index) into some cell. Index is a number indicating which
address (1,2,n) you wish to extract from your string.
==========================================
Option Explicit
Function SepAdr(str As String, index As Long) As String
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "\b\d+\s.*?(?=(\b\d+\b)|$)"
Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern
If oRegex.test(str) = True Then
Set mcMatchCollection = oRegex.Execute(str)
If index <= mcMatchCollection.Count Then
SepAdr = mcMatchCollection(index - 1)
End If
End If
End Function
===============================================
If you prefer a macro that splits this out, similar to the Text-to-Columns
wizard, you can write something similar (entered the same as above):
==============================================
Option Explicit
Sub SepAdr()
Dim c As Range
Dim index As Long
Dim oRegex As Object
Dim mcMatchCollection As Object
Const sPattern As String = "\b\d+\s.*?(?=(\b\d+\b)|$)"
Set oRegex = CreateObject("VBScript.Regexp")
oRegex.Global = True
oRegex.Pattern = sPattern
For Each c In Selection
If oRegex.test(c) = True Then
Set mcMatchCollection = oRegex.Execute(c.Text)
For index = 0 To mcMatchCollection.Count - 1
c.Offset(0, index).Value = mcMatchCollection(index)
Next index
End If
Next c
End Sub
====================================================
To use this, first select the range of addresses. Then <alt-F8> and Run the
SepAdr macro.
--ron
