VBA – How to grab the cell below if a cell has text?

In general, this is really a not a great question, as it fails the rules of StackOverflow, but still, this is some possible answer, producing this output:

Public Sub TestMe()

    Dim myCell As Range
    Dim currentCell As Range: Set currentCell = Range("D1")
    Dim rangeToWrite As Range: Set rangeToWrite = Columns("D:E")
    Dim lastRow As Long: lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Dim myRng As Range: Set myRng = Range(Cells(1, 1), Cells(lastRow, 1))
    Dim stayLeft As Boolean: stayLeft = True
    rangeToWrite.Clear

    For Each myCell In myRng
        If Len(myCell) Then
            If stayLeft Then
                stayLeft = False
                If currentCell.Address <> Range("D1").Address Then
                    Set currentCell = currentCell.Offset(1, -1)
                End If
                currentCell = myCell
            Else
                Set currentCell = currentCell.Offset(0, 1)
                With rangeToWrite
                    If currentCell.Column > .Columns(.Columns.Count).Column Then
                        Set currentCell = currentCell.Offset(0, -1)
                        currentCell = currentCell & vbCrLf & myCell
                    Else
                        currentCell = myCell
                    End If
                End With
            End If
        Else
            stayLeft = True
        End If
    Next myCell

End Sub

The code is quite “tricky” (or nasty), but it works. And stuff like rangeToWrite.Columns(rangeToWrite.Columns.Count).Column can make plenty of the VBA devs out there start hating VBA even more.

What the code does?

• It reads one by one the cells of the first column of the ActiveSheet;
• If the cell is empty, it updates stayLeft to false. This means that the next value would be written in the left column of the Range("D:E");
• It writes the value either on the left or the right column;
• If there are no spaces it keeps writing all the values to the right column, concatenating with the previous value;

Press F8, it is easier to see than to explain!