Transpose Multiple Columns

[Gilbreth]

I have a list of contact that are all listed in column A that I would like to copy and transpose so the information lists across multiple columns (so I can sort the info).

The list is about 10,000 lines long so I don't want to have to copy and transpose each one individualy.

Also, the information for each contact is not consistent as one contact may take up 8 lines of the column while another contact may take up 12 so I can't run a single "copy-paste special-transpose" Macro to take care of the entire sheet (unless there is a way to do this with a forumla?).

I created and ran a couple of Macros for copying and pasting 8, 10, & 12 lines of information but I still have to run the Macro on each individual contact.

Is their a faster way to transpose a list like this??

Thanks!

 

[VoG]

See if you can adapt this http://www.mrexcel.com/forum/showthread.php?t=370651

 

[hkaplan2]

If I understand, your data looks something like this:

Jim Jones
President
100 Broadway
New York, NY 10019
212-555-1212

Mary Smith
VP
55 5th Ave.
Apt 3C
New York, NY 10012
212-55-1234
www.marysmith.com

etc...

If so, is there a full line break between records (as I showed above)? If so, you can actually do a search and replace routine in Word (Excel is limited in this regard).

What you do is replace the record separator (i.e. 2 paragraph characters) with some unusual character (i.e. @@).

Then you replace all of the other paragraph marks with a tab character.

Then you replace the @@ with a paragraph character.

When you copy this and paste back into Excel, you will have one record per line and each field will be in it's own column. This may still not be perfect as the fields may or may not align depending on what your source data looks like. But it may be a start.

 

[d0wnt0wn]

here s a code that i was given to do kind of what you are looking for..... in column a i have my groups numbered from 1 to whatever so if your first contact has 8 rows you would put the number 1 from a1 to a8 then your next contact would be number 2 for however many rows..... it then sorts the differnt groups into columns... my code then pastes it to another workbook but you can take that part out.... i wont be able to edit it for you but maybe you can tweak it to suit your needs.

Sub TranspData()
'Turn off screen updating
Application.ScreenUpdating = False
Dim SourceRange As Range
Dim TargetRange As Range
Dim TargetCell As Range
Dim FindCell As Range
Dim c As Range
Dim i As Integer
Dim mydir As String
mydir = Range("A6").Value
ChDir mydir & ":\estimates\arbutus"
Workbooks.Open Filename:=mydir & ":\estimates\arbutus\database.xls"
Sheets("flat").Select
'Sort the range by group number
Columns("A:E").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'Clear target Cells before pasting lists
Range("m:ap").Clear
'copy and paste data in a transposed fashion
Set SourceRange = Range("A1", Range("A65536").End(xlUp))

SourceRange.Resize(, 2).Sort SourceRange, xlAscending
Set TargetCell = [m2]
TargetCell = SourceRange.Cells(1)
i = 1
For Each c In SourceRange.Offset(1).Resize(SourceRange.Rows.Count - 1, 1)
If c <> c.Offset(-1) Then
TargetCell.Offset(, i) = c
i = i + 1
End If
Next c

Set TargetRange = Range("m2", Range("m2").End(xlToRight))
For Each c In SourceRange.Offset(, 1)
Set FindCell = TargetRange.Find(c.Offset(, -1))
Cells(65536, FindCell.Column).End(xlUp).Offset(1) = c
Next c
'Re-size columns to fit text
Columns("A:BA").EntireColumn.AutoFit
'sort all columns
For i = 14 To 41
Range(Cells(3, i), Cells(100, i)).Sort Key1:=Cells(3, i), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Next i
'copy and paste to estimate workbook
Range("f1:ap100").Select
Selection.Copy
Workbooks(ThisWorkbook.name).Activate
Sheets("flatdb").Select

Range("A2").Select
ActiveSheet.Paste
Columns("A:BA").EntireColumn.AutoFit

'save and close the list database workbook
Windows("database.xls").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close

'reselect Flat Estimates sheet
Sheets("Flat Estimates").Select
Application.ScreenUpdating = True
End Sub

 

[Gilbreth]

Thanks for the reply! I have a few questions about your process.
I've gotten to the point where I have replaced the record seperator with @@ and now all my data looks like "contact information"@@"Contact information" with no breakes between the contacts.

"Then you replace all of the other paragraph marks with a tab character."
How do I so this?

"Then you replace the @@ with a paragraph character."
Is this character "^p"?

Thanks again!!

 

[Gilbreth]

VoG - thanks for your reply. Your method seems to be the cleanist but I am not sophisticated enough to manipulate the code you shared with me. Is there an easy way to explain how to do this so I can make the changes? Thanks Shannon!!

 

[hkaplan2]

FYI my suggestion is "codeless" if you dont know VBA. The code examples are great too.

Yes the paragraph mark is ^p. The tab character (in Word Replace dialog) is under the special button. It is ^t.

To be clear, after you replace 2 paragraph marks with @@, you search for ^p and replace with ^t. Then replace @@ with ^p.

Then copy that data to Excel.

I do this with occasional conversions. No code and takes about a minute.

 

[Gilbreth]

That worked great - thanks!!!