Transposing and looping Data

Hello Everyone,

I'm trying to use VBA Macros to transpose data in column format to row format but I need it to only loop for the first five rows and then place each subsequent five rows underneath the previous ones rather than placing it to the right, Any ideas?? and thankyou so much if you can!

Cephla

Cheers there, If it helps i've included an example of the issue, Thanks again. Cephla

This is designed to work with Sheet1, data in column A and column A only. Let me know more details if you want me to adapt the code to work for your specific worksheet

Sub fiver()
Dim lastrow As Long
Dim rowcount As Long
Dim interval1 As Long
Dim interval2 As Long
Dim nextrowinterval As Long
Dim rowcount2 As Long
With Sheet1
lastrow = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
interval1 = 1
interval = 5
nextrowinterval = 1
For rowcount2 = rowcount To lastrow
For rowcount = interval1 To interval
.Cells(nextrowinterval, Columns.Count).End(xlToLeft).Offset(0, 1).Value = .Cells(rowcount, 1).Value
Next rowcount
interval1 = interval1 + 5
interval = interval + 5
nextrowinterval = nextrowinterval + 1
Next rowcount2
End With
Sheet1.Range("A1").EntireColumn.Delete
End Sub

*Edit: you posted your workbook as I posted my code, let me take a look and make sure it works.

route 1 section 1 doesn't have a bus value in original data set, and does in your hope to create worksheet. So I'm confused there. I'll try to adapt it anyway, let me know if you do so first.

My apologies been rather a long day!!! Dragged the cells down rather sloppily. I've attached an amended version which is hopefully less confusing, cephla

Alright, I hope the code has helped you so far. Last thing though for the headers; I do need to know if that is the actual form of your data, and if it is going to be consistent for when you're using the code. In other words, I can make the code highly specific, highly reliant on the current format, and say something like:

Sheet3.Range("B3:B14").Value = Sheet1.Range("A3:A14")

to add the route1 headers, and so forth. But, I prefer to make the code I write as fluid as possible -- as little reliant on the form of the data as possible (which is how I tried to do it for the swiveling). Just let me know if you are fine with having it in a "stiff" form like that line above, or if you want it fluid I'll need some more information on what stays constant and what doesn't.

Okay, because I don't know I just did the headers hyper-specific (also I'm out of inspiration to come up with neat code for it). So, here's the code in it's prohibitive final form; at worst, it produces the exact "target" sheet you wanted in sheet3. Let me know if you have any questions please, and if this solved the thread then remember to edit/goadvanced/prefix-->[solved] and use the scales.

Sub master()
fiver
sixer
sevener
headers
mover
End Sub

Sub fiver()
Dim LastRow As Long
Dim RowCount As Long
Dim interval1 As Long
Dim interval2 As Long
Dim nextrowinterval As Long
Dim rowcount2 As Long
Dim ColumnCounting As Long
With Sheet1
LastRow = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
interval1 = 3
interval = 7
nextrowinterval = 3
For rowcount2 = RowCount To LastRow
ColumnCounting = 4
For RowCount = interval1 To interval
Sheet3.Cells(nextrowinterval, ColumnCounting).Value = .Cells(RowCount, 4).Value
ColumnCounting = ColumnCounting + 1
Next RowCount
interval1 = interval1 + 5
interval = interval + 5
nextrowinterval = nextrowinterval + 3
Next rowcount2
End With
End Sub
Sub sixer()
Dim LastRow As Long
Dim RowCount As Long
Dim interval1 As Long
Dim interval2 As Long
Dim nextrowinterval As Long
Dim rowcount2 As Long
Dim ColumnCounting As Long
With Sheet1
LastRow = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
interval1 = 3
interval = 7
nextrowinterval = 4
For rowcount2 = RowCount To LastRow
ColumnCounting = 4
For RowCount = interval1 To interval
Sheet3.Cells(nextrowinterval, ColumnCounting).Value = .Cells(RowCount, 5).Value
ColumnCounting = ColumnCounting + 1
Next RowCount
interval1 = interval1 + 5
interval = interval + 5
nextrowinterval = nextrowinterval + 3
Next rowcount2
End With
End Sub
Sub sevener()
Dim LastRow As Long
Dim RowCount As Long
Dim interval1 As Long
Dim interval2 As Long
Dim nextrowinterval As Long
Dim rowcount2 As Long
Dim ColumnCounting As Long
With Sheet1
LastRow = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
interval1 = 3
interval = 7
nextrowinterval = 5
For rowcount2 = RowCount To LastRow
ColumnCounting = 4
For RowCount = interval1 To interval
Sheet3.Cells(nextrowinterval, ColumnCounting).Value = .Cells(RowCount, 6).Value
ColumnCounting = ColumnCounting + 1
Next RowCount
interval1 = interval1 + 5
interval = interval + 5
nextrowinterval = nextrowinterval + 3
Next rowcount2
End With
End Sub

Sub headers()
Dim rowcounter As Long
Dim columnncounter As Long
With Sheet1
columnncounter = 4
For rowcounter = 3 To 7
Sheet3.Cells(2, columnncounter).Value = .Cells(rowcounter, 3).Value
columnncounter = columnncounter + 1
Next rowcounter
End With
With Sheet3
.Range("A3:A14").Value = Sheet1.Range("A3:A14").Value
.Range("B3:B18").Value = Sheet1.Range("B5:B20").Value
.Range("B9:B12").Delete shift:=xlUp
End With
End Sub
Sub mover()
With Sheet3
.Range("C3").Value = Sheet1.Range("D2").Value
.Range("C4").Value = Sheet1.Range("E2").Value
.Range("C5").Value = Sheet1.Range("F2").Value
.Range("C6:C8").Value = .Range("C3:C5").Value
.Range("C9:C11").Value = .Range("C3:C5").Value
.Range("C12:C14").Value = .Range("C3:C5").Value
End With
End Sub

Sub onelesstep()
master
End Sub