Parsing Text

Alex O · Aug 27, 2010

I need a formula (in I2) that will look at H2 and parse out 5608 Ave K then J2 parse out Birmingham AL and K2 35208. This started out relatively easy enough....but the addresses that have Dr, Ave, Ln, etc are messing me up! Any ideas??

Thanks

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 248px"><COL style="WIDTH: 64px"><COL style="WIDTH: 64px"><COL style="WIDTH: 64px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD> </TD><TD>H</TD><TD>I</TD><TD>J</TD><TD>K</TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="TEXT-ALIGN: center; FONT-WEIGHT: bold">Billing Address</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="TEXT-ALIGN: left">5608 Ave K Birmingham AL 35208</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="TEXT-ALIGN: left">105 Shire Dr Pelham AL 35214</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="BACKGROUND-COLOR: #ffff00; FONT-WEIGHT: bold"> </TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left">105 Shire Dr Pelham AL 35214</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left">7735 Old Birmingham Hwy Cottondale AL 35453</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 34px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left">109 Blackwell Ln Oakman AL 35579</TD><TD> </TD><TD> </TD><TD> </TD></TR><TR style="HEIGHT: 51px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left">2005 Old Montgomery Hwy Birmingham AL 35244</TD><TD> </TD><TD> </TD><TD> </TD></TR></TBODY></TABLE>

GTO · Aug 28, 2010

Hi Alex,

Here is my shot...

Workbook Setup:

The first sheet would be a new added worksheet.
Change the tab name to "CityNames".
Change the sheet's codename to "shtCityNames".

The second sheet is the one you have the complete addresses in Col H.
I changed the tab name to "DataSheet".
Change the sheet's CodeName to "shtDataSheet"

Go to http://en.wikipedia.org/wiki/List_of_cities_in_Alabama and copy the contents of the table of cities. Paste this to cell A1 on CityNames.
This sheet will then look something like:

Excel Workbook

A

B

C

D

1

Abbeville

Henry County

2,987

&0000000000000015.61000015.61 sq mi (40.42 km2)

2

Adamsville

Jefferson County

4,965

&0000000000000019.61000019.61 sq mi (50.79 km2)

3

Addison

Winston County

723

&0000000000000003.5100003.51 sq mi (9.10 km2)

4

Akron

Hale County

521

&0000000000000000.5500000.55 sq mi (1.44 km2)

5

Alabaster

Shelby County

22,619

&0000000000000020.53000020.53 sq mi (53.17 km2)

CityNames

It does not matter if the cells are overly tall or too narrow etc., and we'll ditch the empty cells after un-merging. Of course I am only showing several cells for the post; you should have 500 rows data in the first column.

In a Standard Module:

Rich (BB code):

Option Explicit
    
Sub SplitAddresses()
'//*********************************************************************************//
'// Dim REX As RegExp, rexMatches As MatchCollection if Early-Bound                 //
'//*********************************************************************************//
Dim _
aryInput            As Variant, REX             As Object, _
aryOutput           As Variant, rexMatches      As Object, _
aryCityNames        As Variant, rngData         As Range, _
ele                 As Variant, rngOutput       As Range, _
i                   As Long
    
    Set REX = CreateObject("VBScript.RegExp")
    With shtCityNames
        aryCityNames = .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp)).Value
        ReDim aryOutput(1 To UBound(aryCityNames, 1), 1 To 3)
    End With
    
    With shtDataSheet
        Set rngData = .Range(.Range("H2"), .Cells(.Rows.Count, "H").End(xlUp))
        Set rngOutput = rngData.Offset(, 1).Resize(, 3)
        rngOutput.Resize(.Rows.Count - rngOutput.Row).ClearContents
    End With
    aryInput = rngData.Value
    
    With REX
        .Global = False
        .IgnoreCase = False
        For i = 1 To UBound(aryInput, 1)
            If Not aryInput(i, 1) = Empty Then
                For Each ele In aryCityNames
                    .Pattern = "(.+?)(" & ele & ")(.+)"
                    If .Test(aryInput(i, 1)) Then
                        Set rexMatches = .Execute(aryInput(i, 1))
                        aryOutput(i, 1) = rexMatches(0).SubMatches(0)
                        aryOutput(i, 2) = rexMatches(0).SubMatches(1)
                        aryOutput(i, 3) = rexMatches(0).SubMatches(2)
                        Exit For
                    End If
                Next
            End If
        Next
    End With
    rngOutput.Value = aryOutput
    rngOutput.EntireColumn.AutoFit
End Sub
    
Sub SetUpCityNames()
Dim _
i           As Long, _
x           As Long, _
y           As Long, _
aryInput    As Variant, _
aryPattern  As Variant, _
rCell       As Range, _
Pattern     As String
    
    Application.ScreenUpdating = False
    With shtCityNames
        .Columns("B:D").Delete
        With .Range(.Range("A1"), .Cells(.Rows.Count, "A").End(xlUp))
            .Hyperlinks.Delete
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .MergeCells = False
            For i = .Range(.Address).Rows.Count To 1 Step -1
                If Not .Cells(i, "A").Value = vbNullString Then
                    .Cells(i, "A").Value = .Cells(i, "A").Value & Chr(32) & "AL"
                    .Cells(i, "A").TextToColumns Destination:=.Cells(i, "A"), _
                                                 DataType:=xlDelimited, _
                                                 TextQualifier:=xlDoubleQuote, _
                                                 ConsecutiveDelimiter:=True, _
                                                 Tab:=False, Semicolon:=False, _
                                                 Comma:=False, Space:=True, _
                                                 Other:=False, _
                                                 FieldInfo:=Array(Array(1, xlTextFormat), _
                                                                  Array(2, xlTextFormat))
                Else
                    .Cells(i, "A").EntireRow.Delete
                End If
            Next
            .Columns("A:A").Insert
            .Columns("A:F").EntireColumn.AutoFit
            .Rows.EntireRow.AutoFit
        End With
        
        aryInput = _
            .Range(.Range("B1"), _
                   .Cells(RangeFound(.Cells, , , , , xlByRows).Row, _
                          RangeFound(.Cells, , , , , xlByColumns).Offset(, 1).Column) _
                   ).Value
        
        ReDim aryPattern(1 To UBound(aryInput, 1), 1 To 1)
        
        For x = LBound(aryInput, 1) To UBound(aryInput, 1)
            
            Pattern$ = "\b"
            For y = LBound(aryInput, 2) To UBound(aryInput, 2)
                
                Select Case aryInput(x, y)
                Case Empty
                    Pattern$ = Left(Pattern$, InStrRev(Pattern$, "\") - 1)
                    Exit For
                Case "OOR"
                    Pattern$ = Left(Pattern$, InStrRev(Pattern$, "\") - 1) & "\b|"
                Case Else
                    Pattern$ = Pattern$ & aryInput(x, y) & "\ {0,2}"
                End Select
            Next
            aryPattern(x, 1) = Pattern$ & "\b"
        Next
        .Range("A1").Resize(UBound(aryPattern, 1)).Value = aryPattern
        .Range("A1").EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub
    
Function RangeFound(SearchRange As Range, _
                    Optional FindWhat As String = "*", _
                    Optional StartingAfter As Range, _
                    Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
                    Optional LookAtWholeOrPart As XlLookAt = xlPart, _
                    Optional SearchRowCol As XlSearchOrder = xlByRows, _
                    Optional SearchUpDn As XlSearchDirection = xlPrevious, _
                    Optional bMatchCase As Boolean = False) As Range
    
    If StartingAfter Is Nothing Then
        Set StartingAfter = SearchRange(1)
    End If
    
    Set RangeFound = SearchRange.Find(What:=FindWhat, _
                                      After:=StartingAfter, _
                                      LookIn:=LookAtTextOrFormula, _
                                      LookAt:=LookAtWholeOrPart, _
                                      SearchOrder:=SearchRowCol, _
                                      SearchDirection:=SearchUpDn, _
                                      MatchCase:=bMatchCase)
End Function

Now, run SetUpCityNames(). The CityNames sheet should now look like:

Excel Workbook

A

B

C

D

1

\bAbbeville\ {0,2}AL\b

Abbeville

AL

2

\bAdamsville\ {0,2}AL\b

Adamsville

AL

3

\bAddison\ {0,2}AL\b

Addison

AL

4

\bAkron\ {0,2}AL\b

Akron

AL

5

\bAlabaster\ {0,2}AL\b

Alabaster

AL

6

\bAlbertville\ {0,2}AL\b

Albertville

AL

7

\bAlexander\ {0,2}City\ {0,2}AL\b

Alexander

City

AL

8

\bAliceville\ {0,2}AL\b

Aliceville

AL

9

\bAllgood\ {0,2}AL\b

Allgood

AL

10

\bAltoona\ {0,2}AL\b

Altoona

AL

CityNames

SetUpCityNames() only needs run once, but you may wish to save it in case you add other states later. Plunking in a fake variable as an arg will keep it from being run accidently (eg - Sub SetUpCityNames(Fake)).

Although I left the names for ease of reading, you can delete Columns B and thereafter on the CityNames sheet, as only the patterns in Column A are used for the parsing code.

With the below sample data in Col H, after running SplitAddresses:

Excel Workbook

H

I

J

K

1

2

110 N. Hills Dr Akron AL 33423-12323

110 N. Hills Dr

Akron AL

33423-12323

3

334 Old Miner's Rd Bayou La Batre AL 32132

334 Old Miner's Rd

Bayou La Batre AL

32132

4

5

5608 Ave K Birmingham AL 35208

5608 Ave K

Birmingham AL

35208

6

105 Shire Dr Pelham AL 35214

105 Shire Dr

Pelham AL

35214

7

10512 N. SR 88 Alexander City AL 35214

10512 N. SR 88

Alexander City AL

35214

8

105 Shire Dr Pelham AL 35214

105 Shire Dr

Pelham AL

35214

9

7735 Old Birmingham Hwy Cottondale AL 35453

10

109 Blackwell Ln Oakman AL 35579

109 Blackwell Ln

Oakman AL

35579

11

2005 Old Montgomery Hwy BirminghamAL 35244

2005 Old Montgomery Hwy

BirminghamAL

35244

12

2005 Old Montgomery Hwy Bayou La Batre AL 35244

2005 Old Montgomery Hwy

Bayou La Batre AL

35244

DataSheet

This should handle multiple word names (rows 3,7,12), missing data (row 4), errant missing space (row 11) or extra space (row 12).

It will not correct errant missing/extra spaces, but hopefully these are few. I did see that you had a Cottondale listed, which will not return, as its not in our list. For any odd names that are in the wiki list, you could add the pattern to CityNames after running SetUpCityNames.

Hope that helps,

Mark

hiker95 · Aug 29, 2010

GTO,

Amazing!!!!!

Thank you so much - what a great place for learning.

Alex O · Aug 29, 2010

Very Nice...problem solved! I couldn't agree more hiker95...

Parsing Text

Alex O

Active Member

GTO

MrExcel MVP

Excel Facts

hiker95

Well-known Member

Alex O

Active Member

Similar threads

Forum statistics

Share this page

Parsing Text

Alex O

Active Member

GTO

MrExcel MVP

Excel Facts

hiker95

Well-known Member

Alex O

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock