rows to cols

Dear all,
I have the following
a      fname1
b      title1
c      email1
a      fname2
b      title2
c      email2
a      fname3
b      title3
c      email3
a      fname4
b      title4
c      email4

how to converted to
a      b      c
fname1      title1      email1
fname2      title2      email2
fname3      title3      email3
fname4      title4      email4

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

JohnBusiness Consultant (Owner)Commented:
You can use Copy, Paste Special, and Transpose.

But in the example above, you will need to select the ranges individually to transpose.  

If you have only a few ranges, then this will work well. If you have lots of ranges, then you probably need VBA code to do what you want and this is not my forte.

... Thinkpads_User
Other than using customized VBA code to accomplish the exact results, you can play around with a couple options:

1. Select your data and Copy
2. Select another area of the worksheet or even a new sheet
3. Select Paste Special, and from the Paste Special dialog, select Transpose

This will pivot the data, so now you would have to do some additional cut/paste to get the final results

1. Select your data, and Insert a Pivot Table into a new worksheet
2. Move Columns1 and Columns2 into the Rows field

This will group your data under the respective "a", "b", and "c". You can copy out just those cells from the Pivot Table into a new location, and then just type in your own headers
Here's a macro that will do that on column A:

Sub TurnRowsToColumns()
Dim shtOrg As Worksheet, shtDest As Worksheet
Dim lLastRow As Long, lRowLoop As Long

Const lRowsPerBlock As Long = 3
Const lBlankLinesBetweenBlocks As Long = 1

'turn off updates to speed up code execution
With application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set shtOrg = ActiveSheet
Set shtDest = Sheets.Add
 lLastRow = shtOrg.Cells(Rows.Count, 1).End(xlUp).Row

lRowLoop = 0

Do While lRowLoop * lRowsPerBlock < lLastRow
    shtOrg.Cells(lRowLoop * lRowsPerBlock + 1 + lBlankLinesBetweenBlocks * lRowLoop, 1).Resize(lRowsPerBlock).Copy
    shtDest.Cells(lRowLoop + 1, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

    lRowLoop = lRowLoop + 1

With application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Open in new window

byundtMechanical EngineerCommented:
Here is a macro that will let the user select the data to be transposed and specify the number of fields in a record. If the user selects entire columns, the macro will limit the range to rows that have values.

Records may be separated by one or more blank lines (as shown in the data in the Question), or by a repeat of a previously entered field name (first column).

The macro collects field names as it runs. A record does not need to include values for all field names. The macro uses array transfer for speed.

Sub Denormalizer()
Dim rg As Range, targ As Range
Dim FieldNames As Variant, v As Variant, vField As Variant, vv As Variant
Dim bNextRecord As Boolean
Dim i As Long, j As Long, k As Long, nCols As Long, nRows As Long
On Error Resume Next
Set rg = Application.InputBox("Please select the data to be displayed as records.", Type:=8)
If rg Is Nothing Then Exit Sub
nCols = InputBox(" What is the number of fields in a record?")
If nCols = 0 Then Exit Sub
On Error GoTo 0
Set rg = Range(rg.Cells(1, 1), Intersect(rg, rg.Worksheet.UsedRange).Cells(Intersect(rg, rg.Worksheet.UsedRange).Rows.Count, rg.Columns.Count))

nRows = rg.Rows.Count
v = rg.Value
ReDim vv(1 To nRows, 1 To nCols)
ReDim FieldNames(1 To nCols)
bNextRecord = True
For i = 1 To nRows
    If v(i, 1) = "" Then
        bNextRecord = True
        If bNextRecord Then
            k = k + 1
            bNextRecord = False
        End If
        vField = Application.Match(v(i, 1), FieldNames, 0)
        If IsError(vField) Then
            j = j + 1
            FieldNames(j) = v(i, 1)
            vField = j
        End If
        If vv(k, vField) <> "" Then k = k + 1
        vv(k, vField) = v(i, 2)
    End If
rg.Rows(1).Resize(1, nCols).Value = FieldNames
rg.Cells(2, 1).Resize(k, nCols).Value = vv
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.