Concatenate Multiple Cells into A Single Cell

[mark.wolven]

In this case, I want to take a set of values from one sheet where they
are related to a Term and paste into a separate sheet, but paste them
all into a single cell.

I could use the function =concatenate(Sheet1!b15, Sheet1!b16, Sheet1!
b17,Sheet1!b18,Sheet1!b19). And I'd need to add a delimiter in there
making it =concatenate(Sheet1!b15,", ",Sheet1!b16,", ",Sheet1!b17,",
",Sheet1!b18,", ",Sheet1!b19). This is fairly straightforward, but I
have a few of these right now and they range from 3 terms to 17 (in
today's batch).

Is there an easier way to do this? Wouldn't in be nice if the function
CONCATENATE allowed you to specify a range or list and then a
delimiter?

But it doesn't work that way - is there an easier way (than the manual
way described above) that I haven't thought of?

 

[Gary''s Student]

You can make your own function (a UDF):

Function con_kitty_enate(r As Range, sep) As String
If TypeOf sep Is Range Then
v = sep.Value
Else
v = sep
End If

i = 0
For Each rr In r
If IsEmpty(rr) Then
Else
If i = 0 Then
con_kitty_enate = rr.Value
i = 1
Else
con_kitty_enate = con_kitty_enate & v & rr.Value
End If
End If
Next
End Function


So if we have in A1 thru A10:

1
2
3
4
5
6
7
8
9
10

then:

=con_kitty_enate(A1:A24,".")
will display:
1.2.3.4.5.6.7.8.9.10

 

[Gord Dibben]

With a UDF it becomes easy.

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(B1:B32)

Or a macro may be easier yet........no formula 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) - Len(w))
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub


Gord Dibben MS Excel MVP