CODEWITHSUNDEEP
excelvba
Shyam Amrawat
Shyam Amrawat

Reputation: 11

How to use conditional TextJoin in excel horizontally

I have a need to concatenate multiple columns with some criteria as shown in the picture below

Excel snap shot

Wherever there is non zero number, I need to collect all names from the top row as mentioned in the output column

Upvotes: 1

Views: 380

Answers (2)

VBasic2008
VBasic2008

Reputation: 54853

Concatenate Row Matches

Excel

  • If you don't have Office 365 and your screenshot represents the range A1:E4, in cell E2, you could use the following array formula (hold down Ctrl+Shift and press Enter to confirm):

    =TEXTJOIN(", ",,IF($A2:$D2<>0,$A$1:$D$1,""))

    and copy down.

VBA

  • If you don't want the formulas you'll need to use VBA.
Sub ConcatenateHeaders()
    
    Const NOT_CRITERIA As Double = 0
    Const DElIMITER As String = ", "

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Write the values from the source range to a 2D one-based array,
    ' the source array. To simplify (due to lack of information), it is assumed
    ' that the table starts in cell 'A1' and that the destination column
    ' is the last column and has its header already written.
    Dim srg As Range: Set srg = ws.Range("A1").CurrentRegion
    Dim srCount As Long: srCount = srg.Rows.Count
    If srCount < 2 Then Exit Sub ' only headers or no data
    Dim scCount As Long: scCount = srg.Columns.Count - 1
    If scCount < 1 Then Exit Sub ' not enough columns
    Dim sData() As Variant: sData = srg.Value
    
    ' Define the destination array.
    Dim dData() As String: ReDim dData(1 To srCount - 1, 1 To 1)
    Dim dLen As Long: dLen = Len(DElIMITER)
    
    ' Applying the logic, write the required values from the source array
    ' to the destination array.
    Dim sr As Long
    Dim sc As Long
    Dim sValue As Variant
    Dim dString As String
    For sr = 2 To srCount ' from the 2nd row
        ' Write to a string ('dstring').
        For sc = 1 To scCount ' last column excluded (-1)
            sValue = sData(sr, sc)
            If VarType(sValue) = vbDouble Then ' is a number
                If sValue <> NOT_CRITERIA Then ' is not equal
                    dString = dString & sData(1, sc) & DElIMITER ' header row
                'Else ' is equal; do nothing
                End If
            'Else ' is not a number; do nothing
            End If
        Next sc
        ' Check the string.
        If Len(dString) > 0 Then
            dString = Left(dString, Len(dString) - dLen) ' remove trailing del.
            dData(sr - 1, 1) = dString ' write to destination array
            dString = vbNullString ' reset
        'Else ' the string is empty; do nothing
        End If
    Next sr

    ' Write the values from the destination array to the destination range.
    Dim drg As Range: Set drg = srg.Resize(srCount - 1, 1).Offset(1, scCount)
    drg.Value = dData

End Sub

Upvotes: 0

Ike
Ike

Reputation: 13054

If you have Excel 365 (current channel) you can use this formula:

=TEXTJOIN(", ",TRUE,FILTER($A$1:$D$1,A2:D2=1))

(assuming your table starts in A1)

The header row is filtered per value of the current row.

Upvotes: 1

Related Questions