View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default Extracting parts of a cell when only certain words appear

On Wed, 3 Sep 2008 19:11:00 -0700, Craig860
wrote:

Ok brain cramp. I'm going to the Lords of Excel for help with this one.

Lets say:
a1=238 Woodbridge Terrace, Apartment 6,South Hadley, MA 01101
a2=123 Anystreet Rd,Boston, MA 06095
a3=490 Elms St.,Apt 6,Hartford, CT 06090

I'd like to get for results in:
B1=Apartment 6
B2=<blank
B3=Apt 6

As a bonus id like to get
C1=South Hadley
C2=Boston
C3=Hartford

You can probably see by now that source data is inconsistent where not every
line will have an "Apartment" or "Apt". Or am I asking for too much out of
excel? Any help is appreciated.


Here's another approach that might appeal to you.

It depends on every data having the specific information you show, so the
presence of an Apartment number can be differentiated by whether there are 3 or
4 comma-separated fields.

This VBA macro will split "selection" into

B1: Street Address
C1: Apartment (or blank if none)
D1: City
E1: State
F1: Zip

(If there is more potential variability, we will need a more involved coding).

To enter this, <alt-F11 opens the VB Editor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.

To use this, first select the range of addresses to be parsed.
Then <alt-F8 opens the macro dialog box.
Select the macro and RUN

==========================================
Option Explicit
Sub ParseAdr()
Dim aParts
Dim aStateZip
Dim c As Range
Dim i As Long

For Each c In Selection
With Range(c(1, 2), c(1, 6))
.Clear
.NumberFormat = "@"
End With
aParts = Split(Trim(c.Value), ",")
c.Offset(0, 1) = aParts(0) 'street
c.Offset(0, 3) = aParts(UBound(aParts) - 1) 'City
aStateZip = Split(Trim(aParts(UBound(aParts))), " ")
c.Offset(0, 4) = aStateZip(0) 'State
c.Offset(0, 5) = aStateZip(1) 'Zip
If UBound(aParts) = 3 Then
c.Offset(0, 2) = aParts(1)
End If
Next c
End Sub
=====================================
--ron