• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 234
  • Last Modified:

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

2 Solutions
John HurstBusiness 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

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

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now