Need help changing rows into columns

[wstaylor81]

Hi, thank you in advance for the help. Here is my question:
I have a long list of contact information (name, email, phone numbe
etc.) I have to copy this information from a table that is organize
vertically like so...

Column 1 Column 2

Name Brian
Phone (123) 456-7890
Fax (123) 456-7891
Email (e-mail address removed)

Name Carl
Phone 2343214
Fax 1234513
Email (e-mail address removed)


What I need to do is organize this information into columns like so...

Name phone Fax
Email

Brian 2341234 1234134
Brian@
carl 43524 2435234
Carl@


I have been using the paste special and transpose function, but thi
process is very tedious for the long list that I have to do. The tabl
that I am copying from is organized in such a way that I have to cop
the labels in Column 1 along with the information in column 2. So i
order to use paste special I have to copy both columns, and paste bot
columns into excel. Then I have to delete Column 1 then re-copy jus
column 2, then paste special and transpose (does this sound lik
something you want to be doing 1000 times?). There must be an easie
way, but I just don't know it.

Maybe there is a formula that I can use to automate this process. Ca
anybody help me out with this? I am open to any suggestions. Thank yo
very much for your help.

Wil

 

[Tom Ogilvy]

Dim rng as Range, ar as Range
dim rw as Long
rw = 2
with worksheets(2)
.Range("A11") = Array("Name","Phone","Fax","Email")
set rng = Worksheets(1).columns(2).specialCells(xlValues)
for each ar in rng.Areas
.cells(rw,1).Resize(1,4).Value = Application.Transpose(ar)
rw = rw + 1
Next
End With

 

[wstaylor81]

Ok, so I'm kind of a beginner at this and I need a little more hand
holding if I'm gonna figure this out. I'm going to give you exactly the
info that I'm working with and I'm gonna hope that you can give me the
same instruction, just tailored to a beginner. Here is a listings that
looks exactly like what I am copying and pasting into excel.

Column A Column B

Name_______Brian
Title________Dr.
Address_____1 hoover drive
City________Atlantis
State_______Kansa
Zip_________12345
Country_____USA
Phone______23423423
Fax________32425345
(e-mail address removed)
Name... etc.

Then it continues with another one below, and goes on for about a
mile.

I need to know what I need to type, and where I need to type it in
order to turn a list like this into a nice neat spreadsheet with the
headings(name, title, etc.) at the top of each column and the correct
information under each heading. Thank you for helping me figure this
out.

Will

 

[Tom Ogilvy]

Assumptions:
source data has no blank rows in the data.
all blocks of addresses have the same number of rows with labels in the same
location
the source data is the first worksheet in the workbook. The destination
sheet is the second sheet in the workbook

do Alt+F11 which takes you to the VBE. in the menu do Insert=>Menu

paste in this code. Do Alt+F11 to return to Excel

go to Tools=>Macro=>Macros, select ABCD, click Run.


Sub ABCD()
Dim rw1 As Long, rw2 As Long
Dim col2 As Long, Sh1 As Worksheet
Dim sh2 As Worksheet, bDone As Boolean
rw1 = 1
rw2 = 2
col2 = 1
Set Sh1 = Worksheets(1)
Set sh2 = Worksheets(2)
bDone = False
Do While Not IsEmpty(Sh1.Cells(rw1, 1))
If InStr(1, Sh1.Cells(rw1, 1), _
"Name", vbTextCompare) And rw1 <> 1 Then
bDone = True
rw2 = rw2 + 1
col2 = 1
End If
If Not bDone Then sh2.Cells(1, col2).Value = _
Sh1.Cells(rw1, 1).Value
sh2.Cells(rw2, col2).Value = _
Sh1.Cells(rw1, 2).Value
rw1 = rw1 + 1
col2 = col2 + 1
Loop

End Sub

 

[wstaylor81]

It worked like a charm! Thank you very much.

Will