Formula or Macro needed to perform "smart concatenation with seperators"

SStroz used Ask the Experts™

I have an excel workbook with approx. 20 columns (CFP, CPA, etc, etc).  Most rows are "blank" but occasionally there is a "yes" in a column.

I need a formula or macro to read each column (per row), convert the "yes" to the appropriate column heading, and add a separator (, ) if there is another item in a new "concatenated column).

So, the end result would look like this:   CFP, CPA      or CFP     or    CFP, CPA, ChFc

Thanks in advance!!
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
NorieAnalyst Assistant

Are there any other columns?

I'm asking because it would be useful to have a column that could be used to determine how many rows of data there are.

If there is such a thing then this should be straightforward.



Yes there are 48 other columns.  About 170,000 rows.
Software Team Lead
try create a function, and apply it like this:


Open in new window

Function SmartConcat(r As Range)
    Dim tmp As String
    For Each c In r
        If c.Value <> "" Then
            tmp = tmp & Cells(1, c.Column) & ", "
        End If
    If tmp <> "" Then tmp = Left(tmp, Len(tmp) - 2)
    SmartConcat = tmp
End Function

Open in new window

Subodh Tiwari (Neeraj)Excel & VBA Expert
Most Valuable Expert 2018
Awarded 2015

If you are using Excel 2016 or 365, you may use TEXTJOIN function to achieve the desired output.

Try this Array Formula which requires confirmation with Ctrl+Shift+Enter instead of Enter alone.
In AW2
=TEXTJOIN(", ",TRUE,IF(A2:AV2<>"",$A$1:$AV$1,""))

Open in new window

Confirm with Ctrl+Shift+Enter and copy it down.

Otherwise I would not suggest you to have any complex array formula or user defined function for 170,000 rows which will make your file slow.
Even in case of TextJoin after applying the formula, you can copy and paste it back as Values so that the sheet doesn't have any formula in the end to avoid unnecessary recalculation of the formulas.

Or you can try this macro to achieve the desired output.
Sub CustomConcatenate()
Dim ws As Worksheet
Dim lr As Long, lc As Long, i As Long, j As Long
Dim x, y()
Dim str As String
Application.ScreenUpdating = False
Set ws = ActiveSheet
lr = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lc = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
x = ws.Range("A1", ws.Cells(lr, lc)).Value
ReDim y(1 To UBound(x, 1) - 1, 1 To 1)
For i = 2 To UBound(x, 1)
    For j = 1 To UBound(x, 2)
        If x(i, j) <> "" Then
            If str = "" Then
                str = x(1, j)
                str = str & ", " & x(1, j)
            End If
        End If
    Next j
    y(i - 1, 1) = str
    str = ""
Next i
ws.Cells(2, lc + 1).Resize(lr - 1, 1).Value = y

Application.ScreenUpdating = True
MsgBox "Task completed!", vbInformation
End Sub

Open in new window


Thank you all for your help!

Ryan's function worked perfectly so I did not try Subodh's, but I appreciate his efforts!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial