Multi Line Transpose Excel VBA code

[mwilliams4]

I have data that is listed in one long vertical column:

ADAM1
ADAM2
ADAM3
ADAM4
ADAM5
BOAT1
BOAT2
BOAT3
BOAT4
BOAT5

the listings of the "ADAM" and "BOAT" is always 5.
I'm showing two (ADAM and BOAT) in this example, but in my reality
there are thousands.`

I need some code to move this data into horizontal cells like this:

ADAM1 ADAM2 ADAM3 ADAM4 ADAM5
BOAT1 BOAT2 BOAT3 BOAT4 BOAT5

Can someone get me started...

 

[merjet]

Sub macro1()
Dim iCt As Long
Dim iCol As Long
Dim iRow As Long
Set ws = Sheets("Sheet1")
iCol = 2
iCt = 1
iRow = 1
Do Until ws.Cells(iCt, 1) = ""
ws.Cells(iRow, iCol) = ws.Cells(iCt, 1)
If iCt Mod 5 = 0 Then
iRow = iRow + 1
iCol = 1
End If
iCol = iCol + 1
iCt = iCt + 1
Loop
End Sub

Hth,
Merjet

 

[Alan Beban]

I have data that is listed in one long vertical column:

ADAM1
ADAM2
ADAM3
ADAM4
ADAM5
BOAT1
BOAT2
BOAT3
BOAT4
BOAT5

the listings of the "ADAM" and "BOAT" is always 5.
I'm showing two (ADAM and BOAT) in this example, but in my reality
there are thousands.`

I need some code to move this data into horizontal cells like this:

ADAM1 ADAM2 ADAM3 ADAM4 ADAM5
BOAT1 BOAT2 BOAT3 BOAT4 BOAT5

Can someone get me started...

If the functions in the freelydownloadable file at
http://home.pacbell.net/beban are available to your workbook

Set rng = range("a1:a50")
a = rng
b = ArrayReshape(a, rng.Rows.Count / 5, 5)
range("b1:f" & rng.Rows.Count / 5).Value = b

Alan Beban

 

[mwilliams4]

A couple of small tweaks below to get it to run in my environment.
It works great!!!
Thanks


Sub macro1()
Dim iCt As Long
Dim iCol As Long
Dim iRow As Long

iCol = 2
iCt = 1
iRow = 1
Do Until Sheet1.Cells(iCt, 1) = ""
Sheet1.Cells(iRow, iCol) = Sheet1.Cells(iCt, 1)
If iCt Mod 5 = 0 Then
iRow = iRow + 1
iCol = 1
End If
iCol = iCol + 1
iCt = iCt + 1
Loop
End Sub

 

[Gord Dibben]

Using a worksheet function enter this in B1 and copy across to F1

=INDEX($A:$A,(ROWS($1:1)-1)*5+COLUMNS($A:B)-1)

Select B1:F1 and copy down until you get zeros.

I know it's not code but it is one method.


Gord Dibben MS Excel MVP