Concatenating and iterating through multiple Cells VBA excel

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

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.

Answer 2

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