' Post-directionals on street types (123 Somewhere Rd North, or 456 Something Blvd E.,
' for example) will be interpreted incorrectly... and nothing can be done about it
' because it could be that the "North" or "E." belongs to the city name instead; so
' the resulting list will have to be inspected for those possibilities.
Sub CityState()
Dim R As Long, X As Long, Z As Long, Data As Variant
Dim Parts() As String, Result() As String
Const Abbr1 = " ALLEE ALLEY ALLY ALY ANEX ANNEX ANNX ANX ARC ARCADE AV AVE AVEN AVENU" & _
" AVENUE AVN AVNUE BAYOO BAYOU BCH BEACH BEND BND BLF BLUF BLUFF BLUFFS" & _
" BOT BTM BOTTM BOTTOM BLVD BOUL BOULEVARD BOULV BR BRNCH BRANCH BRDGE" & _
" BRG BRIDGE BRK BROOK BROOKS BURG BURGS BYP BYPA BYPAS BYPASS BYPS" & _
" CAMP CP CMP CANYN CANYON CNYN CAPE CPE CAUSEWAY CAUSWA CSWY CEN CENT" & _
" CENTER CENTR CENTRE CNTER CNTR CTR CENTERS CIR CIRC CIRCL CIRCLE CRCL" & _
" CRCLE CIRCLES CLF CLIFF CLFS CLIFFS CLB CLUB COMMON COMMONS COR" & _
" CORNER CORNERS CORS COURSE CRSE COURT CT COURTS CTS COVE CV COVES" & _
" CREEK CRK CRESCENT CRES CRSENT CRSNT CREST CROSSING CRSSNG XING" & _
" CROSSROAD CROSSROADS CURVE DALE DL DAM DM DIV DIVIDE DV DVD DR DRIV" & _
" DRIVE DRV DRIVES EST ESTATE ESTATES ESTS EXP EXPR EXPRESS EXPRESSWAY" & _
" EXPW EXPY EXT EXTENSION EXTN EXTNSN EXTS FALL FALLS FLS FERRY FRRY" & _
" FRY FIELD FLD FIELDS FLDS FLAT FLT FLATS FLTS FORD FRD FORDS FOREST" & _
" FORESTS FRST FORG FORGE FRG FORGE FORK FRK FORKS FRKS FORT FRT FT" & _
" FREEWAY FREEWY FRWAY FRWY FWY GARDEN GARDN GRDEN GRDN GARDENS GDNS" & _
" GRDNS GATEWAY GATEWY GATWAY GTWAY GTWY GLEN GLN GLENS GREEN GRN" & _
" GREENS GROV GROVE GRV GROVES HARB HARBOR HARBR HBR HRBOR HARBORS" & _
" HAVEN HVN HT HTS HIGHWAY HIGHWY HIWAY HIWY HWAY HWY HILL HL HILLS" & _
" HLS HLLW HOLLOW HOLLOWS HOLW HOLWS INLT IS ISLAND ISLND ISLANDS" & _
" ISLNDS ISS ISLE ISLES JCT JCTION JCTN JUNCTION JUNCTN JUNCTON" & _
" JCTNS JCTS JUNCTIONS KEY KY KEYS KYS KNL KNOL KNOLL KNLS KNOLLS LK" & _
" LAKE LKS LAKES LAND LANDING LNDG LNDNG LANE LN LGT LIGHT LIGHTS LF"
Const Abbr = Abbr1 & " LOAF LCK LOCK LCKS LOCKS LDG LDGE LODG LODGE LOOP LOOPS MALL" & _
" MNR MANOR MANORS MNRS MEADOW MDW MDWS MEADOWS MEDOWS MEWS MILL MILLS" & _
" MISSN MSSN MOTORWAY MNT MT MOUNT MNTAIN MNTN MOUNTAIN MOUNTIN MTIN" & _
" MTN MNTNS MOUNTAINS NCK NECK ORCH ORCHARD ORCHRD OVAL OVL OVERPASS" & _
" PARK PRK PARKS PARKWAY PARKWY PKWAY PKWY PKY PARKWAYS PKWYS PASS" & _
" PASSAGE PATH PATHS PIKE PIKES PINE PINES PNES PL PLAIN PLN PLAINS" & _
" PLNS PLAZA PLZ PLZA POINT PT POINTS PTS PORT PRT PORTS PRTS PR" & _
" PRAIRIE PRR RAD RADIAL RADIEL RADL RAMP RANCH RANCHES RNCH RNCHS" & _
" RAPID RPD RAPIDS RPDS REST RST RDG RDGE RIDGE RDGS RIDGES RIV RIVER" & _
" RVR RIVR RD ROAD ROADS RDS ROUTE ROW RUE RUN SHL SHOAL SHLS SHOALS" & _
" SHOAR SHORE SHR SHOARS SHORES SHRS SKYWAY SPG SPNG SPRING SPRNG" & _
" SPGS SPNGS SPRINGS SPRNGS SPUR SPURS SQ SQR SQRE SQU SQUARE SQRS" & _
" SQUARES STA STATION STATN STN STRA STRAV STRAVEN STRAVENUE STRAVN" & _
" STRVN STRVNUE STREAM STREME STRM STREET STRT ST STR STREETS SMT SUMIT" & _
" SUMITT SUMMIT TER TERR TERRACE THROUGHWAY TRACE TRACES TRCE TRACK" & _
" TRACKS TRAK TRK TRKS TRAFFICWAY TRAIL TRAILS TRL TRLS TRAILER TRLR" & _
" TRLRS TUNEL TUNL TUNLS TUNNEL TUNNELS TUNNL TRNPK TURNPIKE TURNPK" & _
" UNDERPASS UN UNION UNIONS VALLEY VALLY VLLY VLY VALLEYS VLYS VDCT" & _
" VIA VIADCT VIADUCT VIEW VW VIEWS VWS VILL VILLAG VILLAGE VILLG" & _
" VILLIAGE VLG VILLAGES VLGS VILLE VL VIS VIST VISTA VST VSTA WALK" & _
" WALKS WALL WY WAY WAYS WELL WELLS WLS "
Const Unit = " SUITE STE APARTMENT APTMT APT FLOOR FLR FL BUILDING " & _
" BUILD BLDG BLD BLG OFFICE OFF OFC ROOM RM UNIT UNT UN "
Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
ReDim Result(1 To UBound(Data), 1 To 1)
For R = 1 To UBound(Data)
Parts = Split(Data(R, 1))
For X = UBound(Parts) - 3 To 1 Step -1
If Parts(X) Like "*[0-9#]*" Or InStr(Abbr & Unit, " " & _
UCase(Replace(Replace(Parts(X), ".", ""), ")", "")) & " ") > 0 Then
For Z = X + 1 - (InStr(Unit, " " & UCase(Replace(Replace(Parts(X), _
".", ""), ")", "")) & " ") > 0) To UBound(Parts) - 1
Result(R, 1) = Result(R, 1) & " " & Parts(Z)
Next
Result(R, 1) = Trim(Result(R, 1))
Exit For
End If
Next
Range("B1").Resize(UBound(Result)) = Result
Next
End Sub
.
