Separate an alphanumeric cell into its components

**zivlaz** · 01-05-2010, 05:38 AM

Hi,
I need to separate the content of every address cell to the four separate cells : city, street, street number, zip code

address cell examples:
98 ironwood street rochester 48063
chesterfield 55 street , Chicago 55660
76 drexler , Bozman , 33087
Collins 230, Austin
etc
etc

I have a comprehensive city list available:
Bozeman
Chicago
Austin
rochester
springfield
Los Angeles
etc

order and location of numbers and texts in address cells is not fixed : 98 ironwood or ironwood 98, city name may appear first etc:
98 ironwood rochester 48063
rochester 48063 ironwood 98

zip code is always 5 digit number
street number is 3 digit or less
Can anyone please point me in the right direction?
Thanks,
Ziv

**martindwilson** · 01-05-2010, 06:14 AM

lots of manual copy paste would be required unles you have something seperating fieldsfor example is there always a ,(comma) between items?

**zivlaz** · 01-05-2010, 06:25 AM

Originally Posted by martindwilson

lots of manual copy paste would be required unles you have something seperating fieldsfor example is there always a ,(comma) between items?

there are usually no commas, just text and numbers. I suppose I could use a function to delete all commas to make it uniform.
city name is one of a finite list of cities I have within the spreadsheet (perhaps 200 or so). Street name is any other text in the cell (no state or country in the cell). any 5 igit number is zip code. Any 3 or less digit number is street number.

**martindwilson** · 01-05-2010, 06:28 AM

attach an example of each variation,

**zivlaz** · 01-05-2010, 07:42 AM

address cell examples:
98 ironwood street rochester 48063
chesterfield 55 street , Chicago 55660
76 drexler , Bozman , 33087
Collins 230, Austin

see attached spreadsheet

Thanks

**pike** · 01-06-2010, 05:00 AM

try...

Code:

Sub ptest()
Dim RegEx As Object
Dim TestStr$, cell As Range
    TestStr = Range("A3").Text
    
    For Each cell In Range("B8:B12")
    TestStr = cell.Value
    Set RegEx = CreateObject("vbscript.regexp")

    With RegEx
        .MultiLine = False
        .Global = False
        .IgnoreCase = True
        .Pattern = "(.*)(Chicago|rochester|Bozman|Austin|San Diego)(.*|$)" '".*|(.*(\d{2,3}\s)|(\d\s).*).*|.*(.*(\d{5}).*).*|.*(.*(Chicago|rochester|Bozman|Auston).*)" '
        If .Test(TestStr) = True Then
       cell.Offset(0, 1) = .Replace(TestStr, "$2")
      End If
      TestStr = .Replace(TestStr, "$1$3")
     .Pattern = "(.*)(\d{5})(.*|$)"
        If .Test(TestStr) = True Then
        cell.Offset(0, 4) = .Replace(TestStr, "$2")
        End If
        TestStr = .Replace(TestStr, "$1$3")
       .Pattern = "(^|.*|\s)(\d+)(\s|.*|$)"
       If .Test(TestStr) = True Then
      cell.Offset(0, 3) = .Replace(TestStr, "$2")
        End If
   cell.Offset(0, 2) = .Replace(TestStr, "$1" & " " & "$3")
End With
Next cell
End Sub

**pike** · 01-06-2010, 05:36 AM

this works with the example

Code:

Sub ptest()
Dim RegEx As Object, matches As Object, match As Object
Dim TestStr$, cell As Range
   For Each cell In Range("B8:B12")
    TestStr = cell.Value
    Set RegEx = CreateObject("vbscript.regexp")

    With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "(.*)(Chicago|rochester|Bozman|Austin|San Diego)(.*|$)" '".*|(.*(\d{2,3}\s)|(\d\s).*).*|.*(.*(\d{5}).*).*|.*(.*(Chicago|rochester|Bozman|Auston).*)" '
        If .Test(TestStr) = True Then
       cell.Offset(0, 1) = .Replace(TestStr, "$2")
      End If
      TestStr = .Replace(TestStr, "$1$3")
     .Pattern = "(.*)(\d{5})(.*|$)"
        If .Test(TestStr) = True Then
        cell.Offset(0, 4) = .Replace(TestStr, "$2")
        End If
        TestStr = .Replace(TestStr, "$1$3")
     .Pattern = "\d+"
       If .Test(TestStr) = True Then
      Set matches = .Execute(TestStr)
        For Each match In matches
       cell.Offset(0, 3) = match
        Next
          End If
         .Pattern = "\d+"
       If .Test(TestStr) = True Then
      cell.Offset(0, 2) = Trim(.Replace(TestStr, ""))
        End If
 End With
Next cell
End Sub

**pike** · 01-06-2010, 06:12 AM

and if there is no street address

Code:

Sub ptest()
    Dim RegEx As Object, matches As Object, match As Object
    Dim TestStr$, cell As Range
    For Each cell In Range("B8:B12")
        TestStr = cell.Value
        Set RegEx = CreateObject("vbscript.regexp")
        With RegEx
            .MultiLine = False
            .Global = True
            .IgnoreCase = True
            .Pattern = "(.*)(Chicago|rochester|Bozman|Austin|San Diego)(.*|$)"
            If .Test(TestStr) = True Then
                cell.Offset(0, 1) = .Replace(TestStr, "$2")
                TestStr = .Replace(TestStr, "$1$3")
            End If
            .Pattern = "(.*)(\d{5})(.*|$)"
            If .Test(TestStr) = True Then
                cell.Offset(0, 4) = .Replace(TestStr, "$2")
                TestStr = .Replace(TestStr, "$1$3")
             End If
            .Pattern = "\d+"
            If .Test(TestStr) = True Then
                Set matches = .Execute(TestStr)
                For Each match In matches
                    cell.Offset(0, 3) = match
                Next
            End If
            If .Test(TestStr) = True Then
                cell.Offset(0, 2) = .Replace(TestStr, "")
            Else
                cell.Offset(0, 2) = TestStr
            End If
        End With
    Next cell
End Sub

**pike** · 01-09-2010, 04:10 AM

If you every come back added code to remove the comas

Code:

Option Explicit
Sub ptest()
    Dim RegEx As Object, matches As Object, match As Object
    Dim TestStr$, cell As Range
    For Each cell In Range("B8:B12")
        TestStr = cell.Value
        Set RegEx = CreateObject("vbscript.regexp")
        With RegEx
            .MultiLine = False
            .Global = True
            .IgnoreCase = True
            .Pattern = "(.*)(Chicago|rochester|Bozman|Austin|San Diego)(.*|$)"
            If .Test(TestStr) = True Then
                cell.Offset(0, 1) = .Replace(TestStr, "$2")
                TestStr = .Replace(TestStr, "$1$3")
            End If
            .Pattern = "(.*)(\d{5})(.*|$)"
            If .Test(TestStr) = True Then
                cell.Offset(0, 4) = .Replace(TestStr, "$2")
                TestStr = .Replace(TestStr, "$1$3")
             End If
            .Pattern = "\d+"
            If .Test(TestStr) = True Then
                Set matches = .Execute(TestStr)
                For Each match In matches
                    cell.Offset(0, 3) = match
                Next
            End If
            If .Test(TestStr) = True Then
                
                cell.Offset(0, 2) = .Replace(TestStr, "")
             cell.Offset(0, 2) = Replace(TestStr, ",", "")
            Else
          
                cell.Offset(0, 2) = Replace(TestStr, ",", "")
            End If
        End With
    Next cell
Set RegEx = Nothing: Set matches = Nothing
End Sub