Vertical cells are separated by one blank cell and the number of "value" rows are random from 4-8. I am trying to transpose every "value" in A column. As I get it, there should be a loop to go from first A to last A row, going thru it should check for blank cell as separator and when it hits/gets to it, it should transpose number of cells that are in specific range between those blanks cells.
From this:
| value |
| value |
| value |
| value |
| blank cell |
| value |
| value |
| value |
| value |
| value |
| blank cell |
To this:
| value | value | value | value |
| value | value | value | value |
Stuck with this code that I stitched from other posts, but can't make it work.
Sub iterateThroughAll()
ScreenUpdating = False
Dim wks As Worksheet
Set wks = ActiveSheet
Dim rowRange As Range
Dim colRange As Range
Dim LastCol As Long
Dim LastRow As Long
LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
Set rowRange = wks.Range("A1:A" & LastRow)
'Loop through each row
For Each rrow In rowRange
'Find Last column in current row
LastCol = wks.Cells(rrow, wks.Columns.Count).End(xlToLeft).Column
Set colRange = wks.Range(wks.Cells(rrow, 1), wks.Cells(rrow, LastCol))
'Loop through all cells in row up to last col
For Each cell In colRange
'Do something to each cell
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Debug.Print (cell.Value)
Next cell
Next rrow
ScreenUpdating = True
End Sub
The simple solution:
Sub iterateThroughAll()
Dim LastRow As Long, i&, j&, k&
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
j = 1: k = 1
For i = 1 To LastRow
If IsEmpty(Cells(i, 1)) Or j > 16384 Then
j = 1: k = k + 1 ' proceed to the first column of the next row
Else
Sheets("Sheet2").Cells(k, j) = Cells(i, 1)
j = j + 1 ' next column
End If
Next
Application.ScreenUpdating = True
End Sub