Combine multiple columns to one with separator, omitting empty col

C

CD-UIO

I have 50 Columns of text data, not all of which contain values, I want to
combine these into one column, with each value separated by a coma, but
omitting those cells with no values. I tried with IF functions and ISNULL,
but it gets a bit long. Any neater solutions?

Thanks a lot
 
D

Don Guillett

Sub combinecols()
Dim ar As Long
Dim i As Long
Dim ms As String
ar = ActiveCell.Row
For i = 1 To Cells(ar, Columns.Count) _
..End(xlToLeft).Column
If Cells(ar, i) <> "" Then
ms = ms & "," & Cells(ar, i)
End If
Next i
MsgBox Right(ms, Len(ms) - 1)
End Sub
 
G

Gord Dibben

Into one column or one cell?

If you are willing to use a User Defined Function.

Function ConCatRange(CellBlock As Range) As String
'for non-contiguous cells =ccr((a1:a10,c4,c6,e1:e5))
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:AX1)

Ignores blank cells.

Note: Excel has a limitation of 32767 characters in a cell with only 1024
of those visible in the cell.

50 columns by many rows could limit out.


Gord Dibben MS Excel MVP
 
C

CD-UIO

Thanks to both Gord and Don for these quick replies,

I should have specified that I want to combine these into one cell for each
row eg My data is from D2:BA2 and I want to combine this into BC2, and then
with D3:BA3 into BC3, D4:BA4 into BC4, etc, etc.

No problem with using a function, but didn't get either of these two to work.

Cheers
Chris
 
C

CD-UIO

Hi,

I've just looked at this again, and basically this is what I need, but how
do I get the result into a cell, not a messagebox? also, can I define which
range is combined, not the whole row?

Many thanks.
Chris
 
G

Gord Dibben

The UDF I posted will work.

In BC2 enter =concatrange(D2:BA2)

Then copy down.


Gord
 
D

Don Guillett

Sub combinecols()
Dim ar As Long
Dim i As Long
Dim j As Long
Dim ms As String
Dim c As Range
On Error Resume Next
For j = 26 To 30 'rows 26:30
For i = 4 To 53 'columns4:53 d:ba
If Cells(j, i) <> "" Then
ms = ms & "," & Cells(j, i)
End If
Next i
Cells(j, 55).Value = Right(ms, Len(ms) - 1)'55 is bc
ms = ""
Next j
End Sub
 
C

CD-UIO

Hi Gord,

Thanks again, yes it works, I think I was copying the function where it
shouldn't have gone.

I modified it slightly like this to include a space after the coma, I had to
think why I was getting the coma af ther the last word, but adjusting the
last row to - 2 seems to have worked.

Many thanks!


Function ConCatRange(CellBlock As Range) As String
'for non-contiguous cells =ccr((a1:a10,c4,c6,e1:e5))
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) - 2)
End Function
 
G

Gord Dibben

Thanks for the update.

And the extra comma fix up.

I had not noticed that defect.

Another version which allows user to decide on de-limiter.

Function ConCatRange22(CellBlock As Range, Optional Delim As String = "") _
As String
'entered as =concatrange22(a1:a10,"|") desired delimiter between quotes
Dim Cell As Range
Dim sbuf As String

For Each Cell In CellBlock.Cells
If Cell.text <> "" Then
sbuf = sbuf & Cell.text & Delim
End If
Next Cell
ConCatRange22 = Left(sbuf, Len(sbuf) - Len(Delim))
End Function


Gord
 
Top