Consolidate row data to columns

[leebauman]

Hello, I need to convert this:

Book20
	A	B	C	D	E	F
1	Order	Item 1	Item 2	Item 3	Item 4	Item 5
2	111	Apple	Orange	Grape
3	222	Lemon	Orange	Apple	Grape	Pear
Sheet1

to this:

Book20
	A	B
6	Order	Item
7	111	Apple
8	111	Orange
9	111	Grape
10	222	Lemon
11	222	Orange
12	222	Apple
13	222	Grape
14	222	Pear
Sheet1

 

[offthelip]

try this code:

Sub test()
Dim outarr()
rowno = Range("A1").CurrentRegion.Rows.Count
colno = Range("A1").CurrentRegion.Columns.Count
inarr = Range(Cells(1, 1), Cells(rowno, colno))
ReDim outarr(1 To rowno * colno, 1 To 2)
 ' put in headers
 outarr(1, 1) = inarr(1, 1)
 outarr(1, 2) = inarr(1, 2)
 indi = 2
 For i = 2 To rowno
   For j = 2 To 5
    If inarr(i, j) = "" Then
     Exit For
    Else
     outarr(indi, 1) = inarr(i, 1)
     outarr(indi, 2) = inarr(i, j)
     indi = indi + 1
    End If
   Next j
 Next i
 Range(Cells(1, 1), Cells(indi, 2)) = outarr
 
End Sub

 

[leebauman]

Terrific. Much appreciated. Thanks.