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

Gurus,

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!!
LVL 7
SStrozAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
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.
0
SStrozAuthor Commented:
Norie,

Yes there are 48 other columns.  About 170,000 rows.
0
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
try create a function, and apply it like this:

=SmartConcat(B2:O2)

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
    Next
    If tmp <> "" Then tmp = Left(tmp, Len(tmp) - 2)
    SmartConcat = tmp
End Function

Open in new window

29116576.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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)
            Else
                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

0
SStrozAuthor Commented:
Thank you all for your help!

Ryan's function worked perfectly so I did not try Subodh's, but I appreciate his efforts!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.