Concatenate a Range of Cells

[Bob Stearns]

I would like to come up with a macro to concatenate a range of cells like
A1:B3 into cell A4 (first row of range, last column of range plus one). I
would like to add a carriage return after concatenating each row. So in
this example A4 would be equal to =CONCATENATE(A1,A2,A3,CHAR(10),B1,B2,B3)

I would like to select the cells and then run the macro.

Any ideas would be greatly appreciated. Thanks...

 

[Guest]

I'm a little unclear on where you want the data to end up (example is
A4-which is last row + 1, first column, but you said first row, last column +
1), so I went with last row + 1, first column.

Does this help?

Sub JoinText()
Dim Col As Range
Dim Cell As Range
Dim Result As String

With Selection
For Each Col In .Columns
For Each Cell In Col.Cells
Result = Result & Cell.Value
Next Cell
If Col.Column < .Columns(.Columns.Count).Column Then _
Result = Result & Chr(10)
Next Col
Cells(.Rows(.Rows.Count).Row + 1, _
.Columns(1).Column).Value = Result
End With
End Sub

 

[Bob Stearns]

Very close to what I want except I want to go row by row instead of column
by column. Like this:

Column A B C D
Row 1 I just want it
Row 2 to read this way

I want to put the result in the first row of the selection in the next
unused column in this case E1. E1 would contain
"I just want it" & CHAR(10) & "to read this way"

Thank you very much!

 

[Leith Ross]

Hello Bob,

Here is a different version take puts the text in rows.

Public Sub ConcatenateRows()

Dim FirstColumn
Dim ColumnCount
Dim FirstRow
Dim LastRow
Dim N
Dim NewCell As Range

With Selection
FirstColumn = .Item(1).Column
ColumnCount = .Columns.Count
FirstRow = .Item(1).Row
LastRow = .Rows.Count + FirstRow - 1
End With

Set NewCell = ActiveSheet.Cells(LastRow + 1, FirstColumn)

For Each Cell In Selection
N = N + 1
NewCell = NewCell & " " & Cell.Value
If N = ColumnCount Then
NewCell = NewCell & vbLf
N = 0
End If
Next Cell

End Sub

Sincerely,
Leith Ros

 

[Bob Stearns]

Leith,

I am using a combination of your and JMB's suggestions. This does what I
need.

Thanks...

---

Public Sub JoinCells()

Dim row_num As Range
Dim cell As Range
Dim result As String

With Selection
For Each row_num In .Rows
For Each cell In row_num.Cells
result = result & cell.Value & " "
Next cell
If row_num.Row < .Rows(.Rows.Count).Row Then result = result & Chr(10)
Next row_num
End With

With Cells(Selection.Row, Selection.Column + Selection.Columns.Count)
.Value = result
.WrapText = True
End With

End Sub