Loop to Cut Down on Long Code

[dj44]

Good day folks,


now my list of transpositons is growing

i was thinking to use something to make it shorter

not the most elegant of solutions

Every 30 rows i transpose





Sub Transpose_Lists()

'Transpose Lists

Dim oWs As Worksheet
Set oWs = ThisWorkbook.Worksheets("Transpose")


'1-30
oWs.Range("B2:B31").Select
oWs.Range("D2") = Join(Application.Transpose(Selection))

'31-60

oWs.Range("B32:B61").Select
oWs.Range("D4") = Join(Application.Transpose(Selection))


'62 -91

oWs.Range("B62:B91").Select
oWs.Range("D6") = Join(Application.Transpose(Selection))

'92 -120

oWs.Range("B92:B120").Select
oWs.Range("D8") = Join(Application.Transpose(Selection))


oWs.Range("B121:B150").Select
oWs.Range("D10") = Join(Application.Transpose(Selection))

' and growing


End Sub




I once had something similar but i cant work out where to put a loop.

thank you for any ideas

[Paul_Hossler]

Probably something like this




Option Explicit


Sub Transpose_Lists()
Dim f As Long, t As Long

With ThisWorkbook.Worksheets("Transpose")

f = 2
t = 2

Do While Len(.Cells(f, 2).Value) > 0
.Cells(t, 4).Value = Join(Application.Transpose(.Cells(f, 2).Resize(30, 1)))
f = f + 30
t = t + 2
Loop

End With

End Sub

[dj44]

Thanks Paul.

now that is some awesome fast transposing.

I can transpose my list so they are manegable in sets.

then i can paste them into word. and read them properly

thanks for helping out as always and for the example book

Thanks again and great day!