VBA Combine each row in into one row

[Jcalma04]

Hello,

I want to combine each row in column A that contains data (so stop process when the next cell is blank) into one single cell. However, each time a row is added I want it to have a new line, except for the last one. I don't know vba that well. I came up with something.

Basically I want to do this:
=A1&char(10)&A2

VBA
Dim i As Integer
i = 0
Do While Not IsEmpty(ActiveCell.Offset(0, -1))
If (i = 0) Then
ActiveCell.FormulaR1C1 = "=RC[-1]"
i = i + 1
Else
ActiveCell.FormulaR1C1 = "&CHAR(10)&RC[-1]"
i = i + 1
End If

Loop

 

[Gary McMaster]

If I understand your question, maybe the sample below will do it. I noticed you were using chr(10) and formulas in your sample code. The sample posted below will combine the text in contiguos blocks of cells into the first cell of each block (area) and delimit the values with chr(10). It is expecting the data in column A to be constants (no formulas) since it appeared to me you were only using a formula to perform the concatenation.

Hope this helps.

Gary

In a standard module:

Public Sub Test()

Dim oCell As Range
Dim oArea As Range
Dim oRange As Range
Dim sText As String
Dim lLastRow As Long

lLastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'Assumes non blank cells in column A are constants and not formulas
Set oRange = ActiveSheet.Range("A1:A" & lLastRow).SpecialCells(xlConstants)

For Each oArea In oRange.Areas
    sText = ""
    For Each oCell In oArea
        sText = sText & oCell.Text & Chr(10)
        oCell.Value = ""
    Next oCell
    sText = Mid(sText, 1, (Len(sText) - 1))
    oArea.Cells(1).Value = sText
Next oArea

End Sub

 

[Jcalma04]

Thank you Gary for all of your help. I figured out what I needed.

Anyone who needs to combine multiple cells into one cell. Use the code below. You must select the cells you want to combine.

Dim vA As Variant
With Selection
x = Cells(1).Value
If .Rows.Count < 2 Then Exit Sub
vA = .Offset(1, 0).Resize(.Rows.Count - 1).Value
For i = LBound(vA, 1) To UBound(vA, 1)
.Cells(1).Value = .Cells(1).Value & Chr(10) & vA(i, 1)
Next i
.Offset(1, 0).Resize(.Rows.Count - 1).Delete shift:=xlUp
End With