Concatenate multiple rows and columns into 1 cell

[Gord Dibben]

Use this UDF which will do the same thing.

Will leave a space between data from each cell.

Ignores blank cells.

Function ConCatRange(CellBlock As Range) As String
Dim cell As Range
Dim sbuf As String
For Each cell In CellBlock
If Len(cell.text) > 0 Then sbuf = sbuf & cell.text & " "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=ConCatRange(A1:C100)

Or a macro which leaves no formulas to deal with.

Sub ConCat_Cells()
Dim x As Range
Dim y As Range
Dim z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter Desired")
Set z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set x = Application.InputBox("Select Cells..Contiguous or Non-Contiguous", _
"Cells Selection", , , , , , 8)
For Each y In x
If Len(y.text) > 0 Then sbuf = sbuf & y.text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Also ignores blank cells.


Gord Dibben MS Excel MVP

 

[Guest]

The function works perfectly.
Thanks!

Use this UDF which will do the same thing.

Will leave a space between data from each cell.

Ignores blank cells.

Function ConCatRange(CellBlock As Range) As String
Dim cell As Range
Dim sbuf As String
For Each cell In CellBlock
If Len(cell.text) > 0 Then sbuf = sbuf & cell.text & " "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=ConCatRange(A1:C100)

Or a macro which leaves no formulas to deal with.

Sub ConCat_Cells()
Dim x As Range
Dim y As Range
Dim z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter Desired")
Set z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set x = Application.InputBox("Select Cells..Contiguous or Non-Contiguous", _
"Cells Selection", , , , , , 8)
For Each y In x
If Len(y.text) > 0 Then sbuf = sbuf & y.text & w
Next
z = Left(sbuf, Len(sbuf) - 1)
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Also ignores blank cells.


Gord Dibben MS Excel MVP