+ Reply to Thread
Results 1 to 13 of 13

Parse, Clean and Format Address Data from Text String

Hybrid View

jerrydiaz Parse, Clean and Format... 12-03-2013, 09:46 AM
Bob Phillips Re: Parse, Clean and Format... 12-03-2013, 10:13 AM
jerrydiaz Re: Parse, Clean and Format... 12-03-2013, 10:54 AM
jerrydiaz Re: Parse, Clean and Format... 12-03-2013, 10:51 AM
jindon Re: Parse, Clean and Format... 12-03-2013, 12:34 PM
jerrydiaz Re: Parse, Clean and Format... 12-03-2013, 01:30 PM
jindon Re: Parse, Clean and Format... 12-03-2013, 01:34 PM
jerrydiaz Re: Parse, Clean and Format... 12-03-2013, 02:37 PM
jerrydiaz Re: Parse, Clean and Format... 12-03-2013, 02:40 PM
jindon Re: Parse, Clean and Format... 12-03-2013, 09:55 PM
jerrydiaz Re: Parse, Clean and Format... 12-04-2013, 09:24 AM
jindon Re: Parse, Clean and Format... 12-04-2013, 11:19 AM
jerrydiaz Re: Parse, Clean and Format... 12-04-2013, 11:52 AM
  1. #1
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Parse, Clean and Format Address Data from Text String

    Hi All—

    I am working with data which is obtained from multiple sources, and thus inconsistent in the way addresses are entered. I have formulas based on location criteria and they need to be uniformly formatted. The basic format needs to be as follows:

    10 W53 St
    565 5 Av

    Some users type out "Street" or "Avenue," some use "Ave." or "St.," etc.

    I have pieced together a basic macro which handles it fairly well, but it is in 3 parts and I often have to run each step twice in order for it to be thorough. My two main issues are:
    1. I would like to be able to combine the 3 parts into 1.
    2. Part 3 occasionally gets caught in a loop of some sort and Excel hangs for a while.
    3. I would like to be able to run the macro on "selected cells" rather than only on Column A. (The code was copied from a macro I found online and am not sure how to modify it so that it's not limited to the one column.


    Following is my code and attached is a spreadsheet with various ways I may receive the data.


    Sub part1()
    
    
    
     On Error Resume Next
     For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
     With Application.WorksheetFunction
     text_string = Range("A" & i).Value
     get_word = Mid(.Substitute(text_string, " ", "^", Len(text_string) - _
     Len(.Substitute(text_string, " ", ""))), .Find("^", .Substitute(text_string, " ", "^", _
     Len(text_string) - Len(.Substitute(text_string, " ", "")))) + 1, 256)
     
      
     
    Select Case get_word
    Case "Ave"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Ave", "Av")
    Case "Avenue"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Avenue", "Av")
    Case "Ave"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Ave", "Av")
    Case "Av"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Av", "Av")
    Case "Av."
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Av.", "Av")
    Case "Ave."
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Ave.", "Av")
    Case "Boulevard"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Boulevard", "Blvd")
    Case "Blvd."
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Blvd.", "Blvd")
    Case "Center"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Center", "Ctr")
    Case "Circle"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Circle", "Cir")
    Case "Court"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Court", "Ct")
    Case "Drive"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Drive", "Dr")
    Case "Heights"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Heights", "Hts")
    Case "Highway"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Highway", "Hwy")
    Case "Lane"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Lane", "Ln")
    Case "Parkway"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Parkway", "Pkwy")
    Case "Place"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Place", "Pl")
    Case "Plaza"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Plaza", "Plz")
    Case "Road"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Road", "Rd")
    Case "Route"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Route", "Rte")
    Case "Street"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Street", "St")
     Case "St"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "St", "St")
    Case "St."
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "St.", "St")
    Case "Turnpike"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Turnpike", "Tpke")
    Case "Apartments"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Apartments", "Apts")
    Case "Building"
     Range("A" & i).Value = .Substitute(Range("A" & i).Value, "Building", "Bldg")
    
    End Select
     
    End With
     Next i
     End Sub
    
    
     
    Sub Part2()
    
    Cells.Replace What:="West", Replacement:= _
            "W", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="East", Replacement:= _
            "E", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=" W ", Replacement:= _
            " W", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:=" E ", Replacement:= _
            " E", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="1st", Replacement:= _
            "1", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="2nd", Replacement:= _
            "2", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="3rd", Replacement:= _
            "3", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="4th", Replacement:= _
            "4", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="5th", Replacement:= _
            "5", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="6th", Replacement:= _
            "6", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="7th", Replacement:= _
            "7", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="8th", Replacement:= _
            "8", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Cells.Replace What:="9th", Replacement:= _
            "9", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False       
    Cells.Replace What:="0th", Replacement:= _
            "0", LookAt:=xlPart, SearchOrder:=xlByRows _
            , MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
    
    End Sub
    
    
    
    Sub Part3()
    Dim c As Range
    For Each c In Selection
        c = InsertSpace(c.Text)
    Next
    End Sub
    
    
    
    Function InsertSpace(str As String) As String
        Dim X As Long
        InsertSpace = str
        For X = 1 To Len(InsertSpace) - 1
          If Mid(InsertSpace, X, 2) Like "[A-Za-z]#" Then
          InsertSpace = Left(InsertSpace, X) & " " & Mid(InsertSpace, X + 1)
          ElseIf Mid(InsertSpace, X, 2) Like "#[A-Za-z]" Then
          InsertSpace = Left(InsertSpace, X) & " " & Mid(InsertSpace, X + 1)
    
        End If
        Next
        InsertSpace = WorksheetFunction.Trim(InsertSpace)
    
    
    For Each cell In Selection
    
    cell.Value = StrConv(cell.Value, vbProperCase) 'Converting Cell Value in to Proper Case
    
    
    Next cell
    
    End Function



    Thanks in advance,
    Attached Files Attached Files

  2. #2
    Forum Expert Bob Phillips's Avatar
    Join Date
    09-03-2005
    Location
    Wessex
    MS-Off Ver
    Office 2003, 2010, 2013, 2016, 365
    Posts
    3,284

    Re: Parse, Clean and Format Address Data from Text String

    Sub part1()
    Dim cell As Range
    Dim text_string As String
    Dim text_no_spaces As String
    Dim get_word As String
    Dim i As Long
    
        For Each cell In Selection
     
            With Application.WorksheetFunction
     
                text_string = cell.Value
                text_no_spaces = .Substitute(text_string, " ", "")
                get_word = Mid(.Substitute(text_string, " ", "^", Len(text_string) - _
                               Len(text_no_spaces)), .Find("^", .Substitute(text_string, " ", "^", _
                               Len(text_string) - Len(text_no_spaces))) + 1, 256)
     
                Select Case get_word
                    Case "Avenue", "Ave", "Ave.", "Av", "Av."
                        cell.Value = .Substitute(cell.Value, get_word, "Av")
                    Case "Boulevard", "Blvd."
                        cell.Value = .Substitute(cell.Value, "Blvd.", "Blvd")
                    Case "Center"
                        cell.Value = .Substitute(cell.Value, "Center", "Ctr")
                    Case "Circle"
                        cell.Value = .Substitute(cell.Value, "Circle", "Cir")
                    Case "Court"
                        cell.Value = .Substitute(cell.Value, "Court", "Ct")
                    Case "Drive"
                        cell.Value = .Substitute(cell.Value, "Drive", "Dr")
                    Case "Heights"
                        cell.Value = .Substitute(cell.Value, "Heights", "Hts")
                    Case "Highway"
                        cell.Value = .Substitute(cell.Value, "Highway", "Hwy")
                    Case "Lane"
                        cell.Value = .Substitute(cell.Value, "Lane", "Ln")
                    Case "Parkway"
                        cell.Value = .Substitute(cell.Value, "Parkway", "Pkwy")
                    Case "Place"
                        cell.Value = .Substitute(cell.Value, "Place", "Pl")
                    Case "Plaza"
                        cell.Value = .Substitute(cell.Value, "Plaza", "Plz")
                    Case "Road"
                        cell.Value = .Substitute(cell.Value, "Road", "Rd")
                    Case "Route"
                        cell.Value = .Substitute(cell.Value, "Route", "Rte")
                    Case "Street", "St", "St."
                        cell.Value = .Substitute(cell.Value, get_word, "St")
                    Case "Turnpike"
                        cell.Value = .Substitute(cell.Value, "Turnpike", "Tpke")
                    Case "Apartments"
                        cell.Value = .Substitute(cell.Value, "Apartments", "Apts")
                    Case "Building"
                        cell.Value = .Substitute(cell.Value, "Building", "Bldg")
                End Select
            End With
            
            cell.Value = InsertSpace(cell)
        Next cell
        
        With Selection
    
            Cells.Replace What:="West", Replacement:="W", _
                          LookAt:=xlPart, SearchOrder:=xlByRows, _
                          MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            Cells.Replace What:="East", Replacement:="E"
            Cells.Replace What:=" W ", Replacement:=" W"
            Cells.Replace What:=" E ", Replacement:=" E"
            Cells.Replace What:="1st", Replacement:="1"
            Cells.Replace What:="2nd", Replacement:="2"
            Cells.Replace What:="3rd", Replacement:="3"
            Cells.Replace What:="4th", Replacement:="4"
            Cells.Replace What:="5th", Replacement:="5"
            Cells.Replace What:="6th", Replacement:="6"
            Cells.Replace What:="7th", Replacement:="7"
            Cells.Replace What:="8th", Replacement:="8"
            Cells.Replace What:="9th", Replacement:="9"
            Cells.Replace What:="0th", Replacement:="0"
        End With
    
    End Sub
    
    Function InsertSpace(cell As Range) As String
    Dim i As Long
    
        InsertSpace = cell.Value
        For i = Len(InsertSpace) - 1 To 1 Step -1
        
            If Mid(InsertSpace, i, 2) Like "[A-Za-z]#" Then
          
                InsertSpace = Left(InsertSpace, i) & " " & Mid(InsertSpace, i + 1)
            ElseIf Mid(InsertSpace, i, 2) Like "#[A-Za-z]" Then
          
                InsertSpace = Left(InsertSpace, i) & " " & Mid(InsertSpace, i + 1)
            End If
        Next
        
        InsertSpace = WorksheetFunction.Trim(InsertSpace)
    
        cell.Value = StrConv(cell.Value, vbProperCase)
    End Function

  3. #3
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    I also occasionally am getting Run-time error 1004: Unable to get the Substitute property of the WorkSheetFunction Class on
     get_word = Mid(.Substitute(text_string, " ", "^", Len(text_string) - _
                               Len(text_no_spaces)), .Find("^", .Substitute(text_string, " ", "^", _
                               Len(text_string) - Len(text_no_spaces))) + 1, 256)

  4. #4
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    Perfect-- Thank you so much!

    I just had to add the
    cell.Value = StrConv(cell.Value, vbProperCase)
    line after "For each cell in selection" since the replace is case-sensitive. Which is fine since I wanted it formatted in TitleCase.

    Just curious though, is there a way to run it without changing case across the board? Anything that is orignally in All Caps is not affected by the macro without doing so.

  5. #5
    Forum Guru
    Join Date
    08-15-2004
    Location
    Tokyo, Japan
    MS-Off Ver
    2013 O.365
    Posts
    22,834

    Re: Parse, Clean and Format Address Data from Text String

    Different method. All in one.
    Option Explicit
    
    Option Compare Text
    
    Sub test()
        Dim r As Range, temp, myReplace As String, Ptn As String
        Ptn = "\b(Av(\.|e(\.|nue))|Boulevard|Blvd\.|Center|Circle|Drive|He?i?gh(way|ts)|Lane|" & _
            "Parkway|Pla(ce|za)|Ro(ad|ute)|St(\.|reet)|Turnpike|Apartments|Building)(?=( |$))"
        With CreateObject("VBScript.RegExp")
            .IgnoreCase = True
            For Each r In Selection
                .Pattern = Ptn
                temp = r.Value
                Do While .test(temp)
                    Select Case .Execute(temp)(0)
                        Case "Av.", "Ave", "Ave.", "Avenue": myReplace = "Av"
                        Case "Boulevard", "Blvd.": myReplace = "Blvd"
                        Case "Center": myReplace = "Ctr"
                        Case "Circle": myReplace = "Cir"
                        Case "Court": myReplace = "Ct"
                        Case "Drive": myReplace = "Dr"
                        Case "Heights": myReplace = "Hts"
                        Case "Highway": myReplace = "Hwy"
                        Case "Lane": myReplace = "Ln"
                        Case "Parkway": myReplace = "Pkwy"
                        Case "Place": myReplace = "Pl"
                        Case "Plaza": myReplace = "Plz"
                        Case "Road": myReplace = "Rd"
                        Case "Route": myReplace = "Rte"
                        Case "Street", "St.": myReplace = "St"
                        Case "Turnpike": myReplace = "Tpke"
                        Case "Apartments": myReplace = "Apts"
                        Case "Building": myReplace = "Bldg"
                    End Select
                    temp = .Replace(temp, myReplace)
                Loop
                .Pattern = "(W|E)[ae]st"
                Do While .test(temp)
                    temp = .Replace(temp, .Execute(temp)(0).submatches(0))
                Loop
                .Pattern = "(\d+)(st|nd|rd|th)"
                Do While .test(temp)
                    temp = .Replace(temp, .Execute(temp)(0).submatches(0))
                Loop
                .Global = True
                .Pattern = "([a-z])(\d)"
                r.Value = StrConv(.Replace(temp, "$1 $2"), 3)
            Next
        End With
    End Sub

  6. #6
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    Thanks- this works well except for the following:
    • Some instances of Ave are not changed to Av (where the address is the only info in the cell)
    • East/West leaves a space after. (i.e., should be 200 E66 St rather than 200 E 66 St)
    • In the cells where the text is "20379449-manhattan 451lexington Av" it isn't separating the 451 from (and capitalizing) Lexington

  7. #7
    Forum Guru
    Join Date
    08-15-2004
    Location
    Tokyo, Japan
    MS-Off Ver
    2013 O.365
    Posts
    22,834

    Re: Parse, Clean and Format Address Data from Text String

    Can you upload a small sample with your desired result?
    So that I can find how you want it.

  8. #8
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    Sure. Here you go. In "orig_v_correct.xlsm" Column A is how I receive data. Column C is how it should read. There are a few tricky situations like West End Av (not to become W End Av) and Center Street to be Center St (not Ctr St) where Rockefeller Center should read Rockefeller Ctr

    I really appreciate your help!
    Attached Files Attached Files

  9. #9
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    orig_v_correct_2.xlsm is a bit easier to read
    Attached Files Attached Files

  10. #10
    Forum Guru
    Join Date
    08-15-2004
    Location
    Tokyo, Japan
    MS-Off Ver
    2013 O.365
    Posts
    22,834

    Re: Parse, Clean and Format Address Data from Text String

    Run the code on "Test" sheet to see the result against your result.

    Some of them are not Exactly the same. Capital letters vs Proper case.
    Attached Files Attached Files

  11. #11
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    This is nearly perfect! Just a couple of things I realized (which could be accomplished with a search/replace too):
            Cells.Replace What:="First", Replacement:="1"
            Cells.Replace What:="Second", Replacement:="2"
            Cells.Replace What:="Third", Replacement:="3"
            Cells.Replace What:="Fourth", Replacement:="4"
            Cells.Replace What:="Seventh", Replacement:="7"
            Cells.Replace What:="Eighth", Replacement:="8"
            Cells.Replace What:="Ninth", Replacement:="9"
            Cells.Replace What:="Tenth", Replacement:="10"
            Cells.Replace What:="Eleventh", Replacement:="11"
            Cells.Replace What:="Americas Av", Replacement:="6 Av"
            Cells.Replace What:="Av*Americas", Replacement:="6 Av"
            Cells.Replace What:="Fifth Av*", Replacement:="5 Av"
            Cells.Replace What:="North", Replacement:="N"
            Cells.Replace What:="South", Replacement:="S"
            Cells.Replace What:="Central Park W*", Replacement:="CPW"
            Cells.Replace What:="Central Pk W*", Replacement:="CPW"
            Cells.Replace What:="Cpw", Replacement:="CPW"

    I realize you did it to compare but please modify so it will run in any column, correcting the selected text rather than create a corrected instance into a different one.

    Thank you so much!!
    Last edited by jerrydiaz; 12-04-2013 at 10:21 AM.

  12. #12
    Forum Guru
    Join Date
    08-15-2004
    Location
    Tokyo, Japan
    MS-Off Ver
    2013 O.365
    Posts
    22,834

    Re: Parse, Clean and Format Address Data from Text String

    1)
            For Each r In Selection
    2)
    r.Value = Application.Trim(StrConv(temp, 3))

  13. #13
    Registered User
    Join Date
    08-10-2012
    Location
    NY
    MS-Off Ver
    Excel 2010
    Posts
    78

    Re: Parse, Clean and Format Address Data from Text String

    Oh ok cool. So is this ok?



    Option Explicit
    
    Option Compare Text
    
    Sub Address_Clean()
    
        Application.ScreenUpdating = False
        
            Cells.Replace What:="West", Replacement:="W"
            Cells.Replace What:="East", Replacement:="E"
            Cells.Replace What:="North", Replacement:="N"
            Cells.Replace What:="South", Replacement:="S"
            Cells.Replace What:="First", Replacement:="1"
            Cells.Replace What:="Second", Replacement:="2"
            Cells.Replace What:="Third", Replacement:="3"
            Cells.Replace What:="Fourth", Replacement:="4"
            Cells.Replace What:="Seventh", Replacement:="7"
            Cells.Replace What:="Eighth", Replacement:="8"
            Cells.Replace What:="Ninth", Replacement:="9"
            Cells.Replace What:="Tenth", Replacement:="10"
            Cells.Replace What:="Eleventh", Replacement:="11"
            Cells.Replace What:="Americas Av", Replacement:="6 Av"
            Cells.Replace What:="Av*Americas", Replacement:="6 Av"
            Cells.Replace What:="Fifth Av*", Replacement:="5 Av"
            Cells.Replace What:="W End", Replacement:="West End"
            Cells.Replace What:="wend Av*", Replacement:="West End Av"
            Cells.Replace What:="Central Park W*", Replacement:="CPW"
            Cells.Replace What:="Central Pk W*", Replacement:="CPW"
            Cells.Replace What:="Cpw", Replacement:="CPW", _
                          LookAt:=xlPart, SearchOrder:=xlByRows, _
                          MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                                  Cells.Replace What:="Central Park W*", Replacement:="CPW"
    
    
        Dim r As Range, temp, myReplace As String, Ptn As String
    
        Ptn = "\b(Av(\.|e(\.|nue)?)|Boulevard|Blvd\.|Circle|Drive|He?i?gh(way|ts)|Lane|" & _
            "Parkway|Pla(ce|za)|Ro(ad|ute)|St(\.|,|reet)|Turnpike|Apartments|Building|Broadway|Terrace)(?= |$)"
        With CreateObject("VBScript.RegExp")
            .IgnoreCase = True
            For Each r In Selection
                temp = Trim$(r.Value)
                .Global = True
                .Pattern = "([a-z])(\d)"
                temp = .Replace(temp, "$1 $2")
                .Pattern = "(.*\d) (ED)(\d.*)"
                temp = .Replace(temp, "$1 $2 $3")
                .Pattern = "(.*[\d ])(W) (\d.*)"
                temp = .Replace(temp, "$1$2$3")
                .Pattern = "(.*\d *)(E) (\d.*)"
                temp = .Replace(temp, "$1 $2$3")
                .Pattern = "\bCenter$"
                temp = .Replace(temp, "Ctr")
                .Global = False
                .Pattern = Ptn
                Do While .test(temp)
                    Select Case .Execute(temp)(0)
                        Case "Av.", "Ave", "Ave.", "Avenue": myReplace = "Av"
                        Case "Boulevard", "Blvd.": myReplace = "Blvd"
                        Case "Circle": myReplace = "Cir"
                        Case "Court": myReplace = "Ct"
                        Case "Drive": myReplace = "Dr"
                        Case "Heights": myReplace = "Hts"
                        Case "Highway": myReplace = "Hwy"
                        Case "Lane": myReplace = "Ln"
                        Case "Parkway": myReplace = "Pkwy"
                        Case "Place": myReplace = "Pl"
                        Case "Plaza": myReplace = "Plz"
                        Case "Road": myReplace = "Rd"
                        Case "Route": myReplace = "Rte"
                        Case "Street", "St.", "St,": myReplace = "St"
                        Case "Turnpike": myReplace = "Tpke"
                        Case "Apartments": myReplace = "Apts"
                        Case "Building": myReplace = "Bldg"
                        Case "Broadway": myReplace = "B'way"
                        Case "Terrace": myReplace = "Terr"
                    End Select
                    temp = .Replace(temp, myReplace)
                Loop
                .Pattern = "(\d+) *(st(?!(\.|$| *\())|(nd|rd|th)\b)"
                Do While .test(temp)
                    temp = .Replace(temp, .Execute(temp)(0).submatches(0))
                Loop
                .Pattern = "(\d+)([a-z])"
                Do While .test(temp)
                    temp = .Replace(temp, .Execute(temp)(0).submatches(0) & " " & .Execute(temp)(0).submatches(1))
                Loop
    
                r.Value = Application.Trim(StrConv(temp, 3))
            Next
        End With
        
                                      
            Cells.Replace What:="Cpw", Replacement:="CPW", _
                          LookAt:=xlPart, SearchOrder:=xlByRows, _
                          MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
           
        Application.ScreenUpdating = True
        
    End Sub
    Last edited by jerrydiaz; 12-04-2013 at 12:25 PM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. [SOLVED] text formula to parse a cell, clean it, and dump into a fixed CELL RANGE - NO MACROS
    By James C in forum Excel Formulas & Functions
    Replies: 11
    Last Post: 03-04-2013, 08:42 PM
  2. Text string clean up formula needed
    By ZimmJJ in forum Excel General
    Replies: 5
    Last Post: 07-01-2012, 09:16 PM
  3. Parse Email address from middle of a string
    By bdb1974 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 06-23-2011, 09:17 PM
  4. How To Parse Specific text from String Data
    By zaidan in forum Excel General
    Replies: 2
    Last Post: 04-08-2011, 04:34 AM
  5. Find and parse email address from text string
    By jchamber00 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 04-28-2009, 11:33 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1