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!