Hello Jesser,
Based on your clarification, I prepared a macro (see end of answer)
that should do what you ask for.
First, let's explain how to add to a spreadsheet. These steps assume
you have a spreadsheet open in Excel.
[1] Use menu item Tools -> Macro -> Visual Basic Editor
If you already have some macros, a "module" window may appear and the
next step might not be necessary.
[2] In the upper left, you should have a window labeled "project"
select your worksheet and then use the menu item Insert -> Module. At
this point a module window will appear and be listed as part of your
worksheet in the project window.
[3] Copy / paste the code into the module window. (fix if needed - see below)
[4] Use the menu to "Close and Return to Microsoft Excel".
At this point, the macro is added to the worksheet. Select a cell
within the data you want to process. You can then use the menu
Tools -> Macro -> Macros...
and select the macro & press Run to run the macro. On my system, it
generated the following information using your sample data:
123 Main St.
345 New Montgomery Way Suite 345
23 Spring St #4
456 N. Arch Way
65 Pensacola Terrace Mail stop 415 B
which appears to be what you asked for.
Let's explain the macro briefly and how to modify it if needed for your needs.
The first section defines an array of street types and initializes the
values. Make sure that MaxStreet matches the number of rows in the
array.
The second section expands the selection to the "current region" (all
non-blank cells adjoining the selection). If you don't want that
feature, comment out the line and your selection must be the range of
cells to process. This section also initializes some variables w/
comments on how to change it if you have a title row or to adjust the
destination of the split values.
The third section is a pair of nested loops. The outer loop is for
each address, the inner loop is for the street types. If you have an
additional condition to compare (e.g., to match "street,") just copy /
paste a block if (if through end if) and fix the match string in the
IfStr function call. I also put a comment in there noting you can
replace the abbreviation with the full street type if desired - please
make a clarification request if you need the code for that.
Please make a clarification request if any part of the answer is
unclear or does not work the way you expected.
Good luck with your work.
--Maniac
Sub Split_Address()
'
' Split_Address Macro
' Macro created 9/29/2005 by Maniac
'
'
' You can certainly change the size of the street type array...
' The following statements initialize the array.
'
MaxStreet = 16
Dim Street$(16, 2)
Street$(1, 1) = "AVENUE"
Street$(1, 2) = "AVE"
Street$(2, 1) = "BOULEVARD"
Street$(2, 2) = "BLVD"
Street$(3, 1) = "CIRCLE"
Street$(3, 2) = "CIR"
Street$(4, 1) = "COURT"
Street$(4, 2) = "CT"
Street$(5, 1) = "DRIVE"
Street$(5, 2) = "DR"
Street$(6, 1) = "FREEWAY"
Street$(6, 2) = "FWY"
Street$(7, 1) = "LANE"
Street$(7, 2) = "LA"
Street$(8, 1) = "LANE"
Street$(8, 2) = "LN"
Street$(9, 1) = "PARKWAY"
Street$(9, 2) = "PKWY"
Street$(10, 1) = "ROAD"
Street$(10, 2) = "RD"
Street$(11, 1) = "SQUARE"
Street$(11, 2) = "SQ"
Street$(12, 1) = "STREET"
Street$(12, 2) = "STR"
Street$(13, 1) = "STREET"
Street$(13, 2) = "ST"
Street$(14, 1) = "TERRACE"
Street$(14, 2) = "TERR"
Street$(15, 1) = "TERRACE"
Street$(15, 2) = "TER"
Street$(16, 1) = "WAY"
Street$(16, 2) = "WAY"
Selection.CurrentRegion.Select
ThisRow = Selection.Row ' +1 if you have a header row
ThisCol = Selection.Column
DestCol = ThisCol + 1 ' change if you want a different destination column
' For each row (cell), check against the possible matches
' This assumes the street type is a whole word
' (check spaces before / after & allow period after abbreviation)
' It does NOT match the street type at the end of the value but
' in that case, goes through the full table / does the default action
' (no split - assign whole value to first column, blank to second column)
For I = 1 To Selection.Rows.Count
ThisAddr$ = Selection.Cells(I, 1).Value
SplitAt = 0
For J = 1 To MaxStreet
MyPos = InStr(1, ThisAddr$, " " & Street$(J, 1) & " ", 1)
If MyPos > 0 Then
' match of full street type
SplitAt = MyPos + Len(Street$(J, 1))
StreetType = J
StreetInd = 1
Exit For
End If
MyPos = InStr(1, ThisAddr$, " " & Street(J, 2) & " ", 1)
If MyPos > 0 Then
' match of abbreviated street type
SplitAt = MyPos + Len(Street$(J, 2))
StreetType = J
StreetInd = 2
Exit For
End If
MyPos = InStr(1, ThisAddr$, " " & Street(J, 2) & ".", 1)
If MyPos > 0 Then
' match of abbreviated street type with period
SplitAt = MyPos + Len(Street$(J, 2)) + 1
StreetType = J
StreetInd = 2
Exit For
End If
Next J
'
' Note - I captured the StreetType & StreetInd values above but do not
' use them below. If desired, you have enough information to replace
' the abbreviation with the full name if desired.
'
If SplitAt = 0 Then
ActiveSheet.Cells(ThisRow + I - 1, DestCol).Value = ThisAddr$
ActiveSheet.Cells(ThisRow + I - 1, DestCol + 1).Value = ""
Else
ActiveSheet.Cells(ThisRow + I - 1, DestCol).Value =
Mid$(ThisAddr, 1, SplitAt)
ActiveSheet.Cells(ThisRow + I - 1, DestCol + 1).Value =
Mid$(ThisAddr$, SplitAt + 2, Len(ThisAddr$))
End If
Next I
End Sub
NOTE: I noticed a couple statements may be "too long", if they are
split into two lines, be sure to put them back together in the Visual
Basic editor (or you'll get an error). |
