Search code examples
excelvba

Transpose data from vertical row to multiple horizontal rows blank space is separator


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

Solution

  • 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