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,