Parsing City, State, Phone Numbers etc

I

iainmunro

New Member
Joined
Apr 20, 2011
Messages
24
Evening

I have a list of addresses that are different lengths etc and have tried different ways to separate out the date with Left, Right, Mid, Text to Columns etc, but don't seem to be getting anywhere.

Here is a sample:
"4834 E. Lincoln Street
Wichita, KS 67218
(316) 684-0290
Classics, Episode DV0101

Williams' Creek Depot - FM 470
Tarpley, TX 78883
(830) 562-3250
www.macandernies.com
Classics, Episode DV0101

3132 East Magnolia Avenue
Knoxville, TN 37914
(865) 524-4388
That's Italian, Episode DV0102

Any ideas as to the best way to get each piece into a column ?

Iain
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
Well you may need to clarify, but if your data is four lines in a wrapped cell, you can use text to columns. When you choose your delineation, uncheck all and then check other. In the blank box, press CTRL-J which is the new line character and that should do it.
 
Upvote 0
iainmunro,

Welcome to the MrExcel forum.


The following sample raw data is based on the groups posted:


Excel Workbook
ABCDEFG
14834 E. Lincoln Street
2Wichita, KS 67218
3(316) 684-0290
4Classics, Episode DV0101
5
6Williams' Creek Depot - FM 470
7Tarpley, TX 78883
8(830) 562-3250
9www.macandernies.com
10Classics, Episode DV0101
11
123132 East Magnolia Avenue
13Knoxville, TN 37914
14(865) 524-4388
15That's Italian, Episode DV0102
16
Sheet1





After the macro:


Excel Workbook
ABCDEFG
14834 E. Lincoln StreetAddressCity ST ZipPhoneInternetEpisode
2Wichita, KS 672184834 E. Lincoln StreetWichita, KS 67218(316) 684-0290Classics, Episode DV0101
3(316) 684-0290Williams' Creek Depot - FM 470Tarpley, TX 78883(830) 562-3250www.macandernies.comClassics, Episode DV0101
4Classics, Episode DV01013132 East Magnolia AvenueKnoxville, TN 37914(865) 524-4388That's Italian, Episode DV0102
5
6Williams' Creek Depot - FM 470
7Tarpley, TX 78883
8(830) 562-3250
9www.macandernies.com
10Classics, Episode DV0101
11
123132 East Magnolia Avenue
13Knoxville, TN 37914
14(865) 524-4388
15That's Italian, Episode DV0102
16
Sheet1





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code: 
Option Explicit
Sub ReorgData()
' hiker95, 04/20/2011
' http://www.mrexcel.com/forum/showthread.php?t=545137
Dim Area As Range, SR As Long, ER As Long, NR As Long, a As Long
Application.ScreenUpdating = False
Range("C1:G1") = [{"Address","City ST Zip","Phone","Internet","Episode"}]
For Each Area In Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  NR = Range("C" & Rows.Count).End(xlUp).Offset(1).Row
  With Area
    SR = .Row
    ER = SR + .Rows.Count - 1
    Range("C" & NR).Resize(, 3).Value = Application.Transpose(Range("A" & SR & ":A" & SR + 2).Value)
    For a = SR + 3 To ER Step 1
      If InStr(Cells(a, 1), ".com") > 0 Then
        Range("F" & NR).Value = Cells(a, 1).Value
      ElseIf InStr(Cells(a, 1), "Episode") > 0 Then
        Range("G" & NR).Value = Cells(a, 1).Value
      End If
    Next a
  End With
Next Area
Columns("C:G").AutoFit
Application.ScreenUpdating = True
End Sub


Then run the ReorgData macro.



If the above is not correct, then we could use some screenshots.


What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net
 
Upvote 0
Hi Hiker95

Many thanks for such a detailed response.

When I look at your screenshots, you have each of the items on different line, but when I look at the Excel File, everything appears to to be on one line so it is not working.

Here is a link to the file:

http://www.box.net/shared/chrdsk52im

Regards

Iain
 
Upvote 0
iainmunro,

Thanks for the file.

Sample data before the macro:


Excel Workbook
CDEFGHI
1Mad Greek's Diner72112 Baker BlvdBaker, CA(760) 733-4354Classics, Episode DV0101
2Brint's Diner4834 E. Lincoln StreetWichita, KS 67218(316) 684-0290Classics, Episode DV0101
3Mac & Ernie'sWilliams' Creek Depot - FM 470Tarpley, TX 78883(830) 562-3250www.macandernies.comClassics, Episode DV0101
4Pizza Palace3132 East Magnolia AvenueKnoxville, TN 37914(865) 524-4388That's Italian, Episode DV0102
5
DinersDrive-insDives





After the macro:


Excel Workbook
CDEFGHI
1Mad Greek's Diner72112 Baker BlvdBaker, CA(760) 733-4354Classics, Episode DV010172112 Baker BlvdBaker, CA(760) 733-4354Classics, Episode DV0101
2Brint's Diner4834 E. Lincoln StreetWichita, KS 67218(316) 684-0290Classics, Episode DV01014834 E. Lincoln StreetWichita, KS 67218(316) 684-0290Classics, Episode DV0101
3Mac & Ernie'sWilliams' Creek Depot - FM 470Tarpley, TX 78883(830) 562-3250www.macandernies.comClassics, Episode DV0101Williams' Creek Depot - FM 470Tarpley, TX 78883(830) 562-3250www.macandernies.comClassics, Episode DV0101
4Pizza Palace3132 East Magnolia AvenueKnoxville, TN 37914(865) 524-4388That's Italian, Episode DV01023132 East Magnolia AvenueKnoxville, TN 37914(865) 524-4388That's Italian, Episode DV0102
5
DinersDrive-insDives





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Code: 
Option Explicit
Sub ReorgDataV2()
' hiker95, 04/21/2011
' http://www.mrexcel.com/forum/showthread.php?t=545137
Dim c As Range, Sp, s As Long
Application.ScreenUpdating = False
Columns("E:I").ClearContents
For Each c In Range("D1", Range("D" & Rows.Count).End(xlUp))
  Sp = Split(c, vbLf)
  c.Offset(, 1) = Sp(0)
  c.Offset(, 2) = Sp(1)
  For s = 2 To UBound(Sp)
    If InStr(Sp(s), "(") > 0 Then
      c.Offset(, 3) = Sp(s)
    ElseIf InStr(Sp(s), "www.") > 0 Then
      c.Offset(, 4) = Sp(s)
    ElseIf InStr(Sp(s), "Episode") > 0 Then
      c.Offset(, 5) = Sp(s)
    End If
  Next s
Next c
Columns("E:I").AutoFit
Application.ScreenUpdating = True
End Sub


Then run the ReorgDataV2 macro.
 
Upvote 0
Hi Hiker95

Thanks - you are a genius.

What can I modify on the code to split out the town, state and zip ?

Iain
 
Upvote 0
iainmunro,


Sample raw data:


Excel Workbook
CDEFGHIJK
1Mad Greek's Diner72112 Baker BlvdBaker, CA(760) 733-4354Classics, Episode DV0101
2Brint's Diner4834 E. Lincoln StreetWichita, KS 67218(316) 684-0290Classics, Episode DV0101
3Mac & Ernie'sWilliams' Creek Depot - FM 470Tarpley, TX 78883(830) 562-3250www.macandernies.comClassics, Episode DV0101
4Pizza Palace3132 East Magnolia AvenueKnoxville, TN 37914(865) 524-4388That's Italian, Episode DV0102
5
DinersDrive-insDives





After the updated macro:


Excel Workbook
CDEFGHIJK
1Mad Greek's Diner72112 Baker BlvdBaker, CA(760) 733-4354Classics, Episode DV010172112 Baker BlvdBakerCA(760) 733-4354Classics, Episode DV0101
2Brint's Diner4834 E. Lincoln StreetWichita, KS 67218(316) 684-0290Classics, Episode DV01014834 E. Lincoln StreetWichitaKS67218(316) 684-0290Classics, Episode DV0101
3Mac & Ernie'sWilliams' Creek Depot - FM 470Tarpley, TX 78883(830) 562-3250www.macandernies.comClassics, Episode DV0101Williams' Creek Depot - FM 470TarpleyTX78883(830) 562-3250www.macandernies.comClassics, Episode DV0101
4Pizza Palace3132 East Magnolia AvenueKnoxville, TN 37914(865) 524-4388That's Italian, Episode DV01023132 East Magnolia AvenueKnoxvilleTN37914(865) 524-4388That's Italian, Episode DV0102
5
DinersDrive-insDives





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


Code: 
Option Explicit
Sub ReorgDataV3()
' hiker95, 04/21/2011
' http://www.mrexcel.com/forum/showthread.php?t=545137
Dim c As Range, Sp, s As Long, H As String, Sp2, ss As Long
Application.ScreenUpdating = False
Columns("E:K").ClearContents
For Each c In Range("D1", Range("D" & Rows.Count).End(xlUp))
  Sp = Split(c, vbLf)
  c.Offset(, 1) = Sp(0)
  H = Replace(Sp(1), ",", "")
  Sp2 = Split(H, " ")
  ss = UBound(Sp2) + 1
  c.Offset(, 2).Resize(, ss).Value = Sp2
  For s = 2 To UBound(Sp)
    If InStr(Sp(s), "(") > 0 Then
      c.Offset(, 5) = Sp(s)
    ElseIf InStr(Sp(s), "www.") > 0 Then
      c.Offset(, 6) = Sp(s)
    ElseIf InStr(Sp(s), "Episode") > 0 Then
      c.Offset(, 7) = Sp(s)
    End If
  Next s
Next c
Columns("E:K").AutoFit
Application.ScreenUpdating = True
End Sub


Then run the ReorgDataV3 macro.
 
Upvote 0
Hi Hiker95

When I tried the last entry you made, I got an error.

I just got back to it and started playing around with it again.

The error I am getting is:

Run Time Error 9

Subscript out of range.

Any ideas ?

Iain
 
Upvote 0
iainmunro,

Can we see the workbook where you are getting the error on?

You can upload your workbook to www.box.net and provide us with a link to your workbook.
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,521
Messages
6,179,275
Members
452,902
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top