Question

I've been wraping my head around it for some time and just don't know how to approach this problem. My table consists of groups of data which I want to transpose from rows to columns. Every row has an index number in first column and all of the rows in one group have the same index.

1 a
1 b
1 c
1 d
1 e
1 f
1 g
1 h
2 as
2 bs
2 cs
5 ma
5 mb
5 mc
5 md

and I want my final result to be:

1 a b c d e f g h
2 as bs cs
5 ma mb mc md

is it possible to do this with formulas or do I have to do it in VBA?

Was it helpful?

Solution

You can also do this using a macro. Here is one method.

To enter this Macro (Sub), alt-F11 opens the Visual Basic Editor. Ensure your project is highlighted in the Project Explorer window. Then, from the top menu, select Insert/Module and paste the code below into the window that opens.

To use this Macro (Sub), alt-F8 opens the macro dialog box. Select the macro by name, and RUN.

Option Explicit
Sub ReArrange()
    Dim vSrc As Variant, rSrc As Range
    Dim vRes As Variant, rRes As Range
    Dim I As Long, J As Long, K As Long
    Dim lColsCount As Long
    Dim Col As Collection
'Upper left cell of results
Set rRes = Range("D1")

'Assume Data in A1:Bn with no labels
Set rSrc = Range("a1", Cells(Rows.Count, "A").End(xlUp)).Resize(columnsize:=2)

'Ensure Data sorted by index number
rSrc.Sort key1:=rSrc.Columns(1), order1:=xlAscending, key2:=rSrc.Columns(2), order2:=xlAscending, MatchCase:=False, _
    Header:=xlNo

'Read Source data into array for faster processing 
'  compared with going back and forth to worksheet
vSrc = rSrc

'Compute Number of rows = unique count of index numbers
'Collection object can only have one entry per key
'  otherwise it produces an error, which we skip
Set Col = New Collection
On Error Resume Next
For I = 1 To UBound(vSrc)
    Col.Add Item:=vSrc(I, 1), Key:=CStr(vSrc(I, 1))
Next I
On Error GoTo 0

'Compute Maximum Number of columns in results
'  Since there is one entry per Index entry, maximum number of
'  columns will be equal to the Index that has the most lines
'  So we iterate through each Index and check that.
For I = 1 To Col.Count
    J = WorksheetFunction.CountIf(rSrc.Columns(1), Col(I))
    lColsCount = IIf(J > lColsCount, J, lColsCount)
Next I

'Set up Results array
'  Need to add one to the columns to account for the column with the Index labels
ReDim vRes(1 To Col.Count, 1 To lColsCount + 1)

'Now populate the results array
K = 1
For I = 1 To Col.Count
    vRes(I, 1) = vSrc(K, 1)
    J = 2
    Do
        vRes(I, J) = vSrc(K, 2)
        J = J + 1: K = K + 1
        If K > UBound(vSrc) Then Exit Do
    Loop Until vSrc(K, 1) <> vRes(I, 1)
Next I

'Set the results range to be the same size as our array
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1), columnsize:=UBound(vRes, 2))

'Clear the results range and then copy the results array to it
rRes.EntireColumn.Clear
rRes = vRes

'Format the width.  Could also format other parameters
rRes.EntireColumn.ColumnWidth = 10

End Sub

OTHER TIPS

Yes its possible. You would need the following functions:

  1. IF
  2. MATCH
  3. ISNA
  4. INDEX

Assume you have the data in sheet 1 in columns A and B:

enter image description here

C1:

place the value "1" in cell C1

C2:

=C1+1

drag down as much as needed

D1

=MATCH(C1,A:A, 0)

Drag down as much as cell C2

E1

=MATCH(C1,A:A, 1)

Drag down as much as cell C2

Sheet 2: enter image description here

Now place the following formulas in cell A1 in sheet2:

=IF(ISNA(Sheet1!$D1), "", IF(Sheet1!$D1="", "", IF(COLUMN()-1+Sheet1!$D1 <=Sheet1!$E1, INDEX(Sheet1!$B:$B, COLUMN()-1+Sheet1!$D1), "")))

Drag / Copy it to as many cells as needed:

enter image description here

Result:

enter image description here

Also I have an article on my blog about the INDEX function. It might help Excel INDEX Function.

You can also download the complete file here.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top