Concatenating and iterating through multiple Cells VBA excel - vba

Question

I want to iterate through data (simular to that shown below) that is stored in different cells and combine them into a single cell seperated by a new line (chr(10)). The amount of data that needs to be imported into one cell will change.
2991
19391
423
435
436
The code needs to iterate through the whole sheet regardless of any line breaks. The required format is:
2991 - all three cells would be combined into one cell in the next column to this one.
19391
423
-Line space, this will need to be taken into account and is the seperator of data.
26991 - all four cells would be combined into one cell in the next column to this one.
19331
424
6764
Below is what I have got so far, it takes the column to the left of the current row and combines it, which is wrong.
Sub ConcatColumns()
Do While ActiveCell <> "" 'Loops until the active cell is blank.
ActiveCell.Offset(0, 1).FormulaR1C1 = _
ActiveCell.Offset(0, -1) & chr(10) & ActiveCell.Offset(0, 0)
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Answer 1

You can achieve the above with this code
Sub Main()
Dim i As Long
Dim c As Range
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
Dim strBuilder As String
Set c = Range("A" & i)
If Not IsEmpty(c) And i <> 1 Then
strBuilder = c & Chr(10) & strBuilder
ElseIf i = 1 Then
strBuilder = c & Chr(10) & strBuilder
c.Offset(0, 1) = Left(strBuilder, Len(strBuilder) - 1)
strBuilder = vbNullString
Else
c.Offset(1, 1) = Left(strBuilder, Len(strBuilder) - 1)
strBuilder = vbNullString
End If
Next i
End Sub

Answer 2

I think this could be done using a UDF.
Something like
Public Function JoinValues(rng As Range) As String
Dim cell As Range
Dim str As String
For Each cell In rng
If cell.Value <> "" Then
str = str & cell.Value & Chr(10)
End If
Next cell
If Len(str) > 1 Then JoinValues = Left(str, Len(str) - 1)
End Function
Then usage would be =JoinValues(A1:A10) in a cell to join values. You would also have to change cell formatting in the target cell to allow wrapping text for this to work properly.
Assuming your values start in cell A2 enter
=IF(A1="",joinvalues(OFFSET(A2,0,0,MATCH(TRUE,INDEX(ISBLANK(A2:A10000),0,0),0)-1)),"")
in B2 and drag the function down.