transpose variable array

[JBG]

Hi,
Please, I need some help with the following formula/macro. I want the data
in columns Cat1, Cat2 and Cat3 to be transposed into one single column
("List" column on the left), but the lenght of the array being transposed
should vary based on the Cat Count column. I am putting an example below in
case it helps.
Thanks very much.

List Cat count Cat 1 Cat 2 Cat 3
A 1 A
B 2 B A
A 0
0
B 3 B A C
A 0
C 0

 

[ryguy7272]

I think this is what you want:
Sub settupp()
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
s1.Activate
n = Cells(Rows.Count, 1).End(xlUp).Row
k = 1
For i = 1 To n
fst = Cells(i, 1).Value
For j = 1 To 5
snd = Cells(i, j).Value
s2.Cells(k, 1) = fst
s2.Cells(k, 2) = snd
k = k + 1
Next
Next
End Sub

HTH,
Ryan---

 

[JBG]

Thanks Ryan.
Your solution is pretty close to what I need, but it is always transposing 5
rows instead of the number defined in "Cat count" column. I have some extra
information on the left that I will use for pivot tables, so I need to keep
the same number of rows. Any other idea?

Thanks again for your help

 

[Patrick Molloy]

Option Explicit
Sub buildList()
Dim rw As Long
Dim col As Long
Range("A:A").ClearContents
Range("A1") = "List"
rw = 2
Do Until Cells(rw, "B") = ""
If Cells(rw, "B") = 0 Then
Range("A65000").End(xlUp).Offset(1) = " "
Else
For col = 1 To Cells(rw, "B").Value
Range("A65000").End(xlUp).Offset(1) = Cells(rw,
"B").Offset(, col)
Next
End If
rw = rw + 1
Loop
End Sub

 

[Rick Rothstein]

Here is my attempt at what you asked for. Assuming the List will be place in
Column A and that Cat 1, Cat 2 and Cat 3 are in Columns C, D and E (I don't
use the Cat Count in my code which allows for gaps in your Cat information
in case that is a possibility for your data; for example, something in Cat 1
and Cat 3 with Cat 2 remaining empty)...

Sub MakeTransposedList()
Dim V As Variant
Dim X As Long, Z As Long, LastRow As Long, OffsetAmount As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For X = 2 To LastRow
V = WorksheetFunction.Transpose(WorksheetFunction.Transpose( _
.Range("C2:E2").Offset(OffsetAmount)))
For Z = 1 To 3
If V(Z) <> "" Then
.Range("A2").Offset(OffsetAmount).Value = V(Z)
OffsetAmount = OffsetAmount + 1
End If
Next
Next
End With
End Sub

 

[JBG]

This works great!!! Thanks very much.
I twiked it a bit by removing the If condigion as it was going a few lines
off when the original line did not have any values, but by sorting them
before creating the extra lines I solve the problem.
Thanks again for your help.

Sub buildList()
Dim rw As Long
Dim col As Long
Range("A:A").ClearContents
Range("A1") = "List"
rw = 2
Do Until Cells(rw, "B") = ""
For col = 1 To Cells(rw, "B").Value
Range("A65000").End(xlUp).Offset(1) = Cells(rw, "B").Offset(, col)
Next
rw = rw + 1
Loop
End Sub

 

[JBG]

Thanks rick,
This works great as well, and although I won't have empty data in between
for this case I may certainly use it in the future.
Thanks again.