reformat contact data

[CarlJ]

Hello everyone,

I know many may have this same problem, I hope the answer helps a lot of
people.

I have a list of 1000 contacts that are in vertical order, not very
database friendly. I would like to change the contact info so they are in
colums cells not row cells. Some have email address, some dont .
Their is a space between each orginal contact if that helps.I have tried may
methods but none has worked

Example

From this

Joe Smoe
122 W 123 Lake
Phila,Pa 19120
954-633-5656

Billy Bon
122 W 123 Lake
Phila,Pa 19120
954-633-4141

To this

Joe Smoe | 122 W 123 Lake | Philadelphia,Pa 19120 |954-633-5656
Billy Bon | 122 W 123 Lake | Philadelphia,Pa 19120 |954-633-4141

The more suggestions the better . Thank you very much for your help
Carl

 

[BobT]

This will do it.

Bob Tulk
MOUS (XP/97)

------------
Sub ToCols()
'While not at the end of the list.
While ActiveCell.Row < 100
'If the next row is empty, we're done with this record.
x = 1
While ActiveCell.Offset(1, 0).Value <> ""
ActiveCell.Offset(0, x).Value = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Delete xlUp
x = x + 1
Wend
'Move onto the next record.
ActiveCell.Offset(1, 0).Select
ActiveCell.Delete xlUp
Wend
End Sub

 

[CarlJ]

hello Bob,
thank you very much for your reply. Your macro worked like a charm for the
small list.

Some of the larger list crashed. i did a print screen to show you . I also
included a link to a sample of the data I'm referring to.
I really appreciate your time and effert

Screen Shot www.johnsontraining.net/macro.jpg
Sample Sheet www.johnsontraining.net/sample_excel.xls

Thank you,
Carl