Parse Adress into seperate columns

[danpotash]

Can someone be so kind to help me with building a macro for my issue I am trying to split address elements in separate columns some of the addresses have zip codes some do not some have country name some do not below is the format of the data that I have I would like to separate it into address city state zip and country

42 CHARLES DR RICHBORO PA 18954

130 E 72NO ST APT 4 NEW YORK NY 10021

205 OSERAVE HAUPPAUGE NY 11788

77 Northeastern BLVD NASHUA NH 3062

3900 GREEN OAK OR WACO TX 76710

11303 VIEW HIGH DR KANSAS CitY MO 64134 us

6070 GlJLFPbRt BLVD 5 ST PETERSBURG FL 33707 us

600 Delzan PI LEXINGTON KY 40503 us

180 E END AVE APT 4B NEW YORK CITY NY 10128

3 RIVERWAY STE 1800 HOUSTON TX 77056

15117 Illinois Avenue PARAMOUNT CA 90723

6700 Guadalupe Street AUSTIN TX 78752

179 GLEN RD CHAGRIN FALLS OH 44022

790 IVANHOE ST DENVER co 80220 us

60 East 42nd Street NEW YORK NY 10165

550 S HILL STREET LOS ANGELES CA 90013

179 WALLABOUT ST BROOKLYN NY 11206

1100 E Main Sl MORRISTOWN TN 37814

150 S Wacker Drive Ste 450 CHICAGO IL 60606

2970 MARKET ST PHILADELPHIA PA 19104 us

8301 S CASS AVE STE 203 DARIEN IL 60561

10580 JUSTIN DR URBANDALE lA

200 MOTOR PKWY HAUPPAUGE NY 11788

2040 N 91st St LINCOLN NE 68505 us

1006 BROWN ST PEEKSKILL NY 10566

514 BETHJ\NY CIR MURFREESBORO TN 37128 us

1400 S VANDEVENTER AVENUE ST. LOUIS MO 63110

26052 COLMAN DR WARREN Ml 48091 us

1225 MERIDIAN ST N HUNTSVILLE AL 35801

1700 Boardwalk WILDWOOD NJ 8260 us

350 5TH AVE STE 7413 NEW YORK CITY NY 10118 us

14 WALL ST 2RD FL NEW YORK CITY NY 10005 us

4195 SERPENTINE WAY MASON OH 45040

15543 VALERIO ST VAN NUYS CA 91406 us

15543 VALERIO ST VAN NUYS CA 91406 us

3235 Pole Line Road POCATELLO ID 83201

160 27th Street BROOKLYN NY 11232

206 Minden Rd MINDEN wv 25B79 US

710 S 4th Street LAMAR co 81052

100 E PEARL ST H.t1RRISONVILLE MO 64701 us

<tbody>
</tbody><colgroup><col></colgroup>

 

[mikerickson]

Addresses are so very idiocyncratic that a general algorithm won't work. The best help that I can offer is these routines that will move a word one cell to the right (with a right click) or the left (with a double click) to help tidy up after trying an alorythm.

You could use TextToColumns with a space delimiter and then Double click on cells until everything is in nice columns.

let me add one more possible address
23 1/2 Smith St. St. Croix IL

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Words As Variant
    With Target
        If 1 < .Column Then
            Words = Split(CStr(.Value), " ")
            If 0 <= UBound(Words) Then
                
                .Offset(0, -1).Value = Application.Trim(.Offset(0, -1).Value & " " & Words(0))
                .Value = Application.Trim(Replace(CStr(.Value), Words(0), vbNullString, , 1))
            End If
            
        End If
        Cancel = True
    End With
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim Words As Variant
    Cancel = True
    With Target
        Words = Split(CStr(.Value), " ")
        If -1 < UBound(Words) Then
            .Offset(0, 1).Value = Application.Trim(Words(UBound(Words)) & " " & .Offset(0, 1).Value)
            If UBound(Words) = 0 Then
                .Value = vbNullString
            Else
                ReDim Preserve Words(0 To UBound(Words) - 1)
                .Value = Join(Words, " ")
            End If
        End If
    End With
End Sub