Concatenate multiply values based on unique value

[EGname]

Hi everyone,
I am looking for help in formula or VBA for situation:

columnA columnB
1 ______ a
2 ______ s
2 ______ d
2______ f
3 ______ g
1______ h
3 ______ j
3______ k

I need to concatenate values of column B by unique value of column A. Final product will look like:

columnC columnD
1 ______ a,h
2 ______ s,d,f
3 ______ g,j,k

Thank you very much for any help!!

 

[Eric W]

If you have Excel 2016 with the new TEXTJOIN function, you can do this:

	A	B	C	D
1	1	a	1	a,h
2	2	s	2	s,d,f
3	2	d	3	g,j,k
4	2	f
5	3	g
6	1	h
7	3	j
8	3	k
9
10

<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Worksheet Formulas Cell Formula C1 =MIN(A1:A10) C2 =IF(C1="","",IFERROR(SMALL($A$1:$A$10,COUNTIF($A$1:$A$10,"<="&C1)+1),"")) <thead> </thead><tbody> </tbody>

<tbody>
</tbody>

Array Formulas Cell Formula D1 {=IF(C1="","",TEXTJOIN(",",TRUE,IF($A$1:$A$10=C1,$B$1:$B$10,"")))} <thead> </thead><tbody> </tbody> Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}. Note: Do not try and enter the {} manually yourself

<tbody>
</tbody>

Put the formula in C1. Then put the formula in C2 and copy down. These formulas assume that column A is all numbers. Then put the formula in D1, confirm with Control+Shift+Enter and copy down.


If you don't have the TEXTJOIN function, you'll either need to use a helper row from E to Z (or however many matches you expect from column A), or use VBA. Here's a UDF that mimics TEXTJOIN:

Right click on the sheet tab on the bottom of your sheet and select View Code. From the menu, click Insert > Module. Then paste this:

Function TextJoinX(sep As String, ign As Boolean, ParamArray SubArr() As Variant) As String
Dim i As Long, y As Variant
' Clone of TextJoin for versions of Excel prior to 2016
' 2016, Eric W, adapted from AConcat by Harlan Grove

    TextJoinX = ""
    For i = LBound(SubArr) To UBound(SubArr)
        If TypeOf SubArr(i) Is Range Then
            For Each y In SubArr(i).Cells
                If y = "" And ign Then
                Else
                    TextJoinX = TextJoinX & y.Value & sep
                End If
            Next y
        ElseIf IsArray(SubArr(i)) Then
            For Each y In SubArr(i)
                If y = "" And ign Then
                Else
                    TextJoinX = TextJoinX & y & sep
                End If
            Next y
        Else
            If SubArr(i) = "" And ign Then
            Else
                TextJoinX = TextJoinX & SubArr(i) & sep
            End If
        End If
    Next i
    
    If Len(TextJoinX) > 0 Then _
        TextJoinX = Left(TextJoinX, Len(TextJoinX) - Len(sep))
        
End Function

Then press Alt-Q to close the VBA editor. Now just enter the formulas as before, using TEXTJOINX instead of TEXTJOIN.

Hope this helps.

 

[EGname]

Eric,

Thank you very much. I have Excel 2010. After I followed the steps I have got in C2 formula =IF(C1="","",IFERROR(SMALL($A$1:$A$10,COUNTIF($A$1:$A$10,"<="&C1)+1),"")) showing, not value
And in D1 I have got {} in array formula after Ctrl+Shift+Enter as you specified, but the formula returned with #NAME?

Did I do something different?

Thank you
Elina

 

[EGname]

Eric

I found my mistake in C2. I have C2 and down correct returns now. But D1 still returns with #NAME?.

 

[sergioMabres]

Hi Elina
Also in Mr Excel after testing Eric's formula, you could try what I found, a very usefull UDF that works like CoutIf or SumIf

Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
                            Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
    ' By mikerickson at MrExcel MVP
    ' at http://www.mrexcel.com/forum/excel-questions/365691-concatenate-multiple-cells-array-formula.html
    Dim i As Long, j As Long
    With compareRange.Parent
    Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
     End With
    If compareRange Is Nothing Then Exit Function
    If stringsRange Is Nothing Then Set stringsRange = compareRange
    Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
                                                stringsRange.Column - compareRange.Column)
    
        For i = 1 To compareRange.Rows.Count
            For j = 1 To compareRange.Columns.Count
                If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                    If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                        ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
                    End If
                End If
            Next j
        Next i
        ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
    End Function

Thank mikerickson
Cheers
Sergio

 

[Eric W]

If you get a #NAME error in D1, it's most likely that you spelled the TEXTJOINX function wrong, or installed it in the wrong place. Press Alt-F11 to open the VBA editor. On the left hand navigation pane you should have the name of your spreadsheet, then a sheet for each of the worksheets in your spreadsheet (Sheet1, Sheet2, etc.) then ThisWorkbook, then the modules: Module1, and possibly Module2, etc. Double click on Module1 and you should see the code for TEXTJOINX. Make sure it's there, and not on any of the other sheets.

If you want to try Mike's UDF that Sergio kindly located, install it according to the instructions in post #2, then use a formula in D1 like this:

=IF(C1="","",concatif($A$1:$A$10,C1,$B$1:$B$10,","))

with just a regular Enter, no CSE needed.

Let us know how you fare.

 

[EGname]

Eric
Thank you.
The code sits in Module 1 in folder: VBA Project (Personal. XLSB) - Modules -Module 1. Is it the right place?
That is what I have in Module 1:

Function TextJoinX(sep As String, ign As Boolean, ParamArray SubArr() As Variant) As String
Dim i As Long, y As Variant
' Clone of TextJoin for versions of Excel prior to 2016
' 2016, Eric W, adapted from AConcat by Harlan Grove

TextJoinX = ""
For i = LBound(SubArr) To UBound(SubArr)
If TypeOf SubArr(i) Is Range Then
For Each y In SubArr(i).Cells
If y = "" And ign Then
Else
TextJoinX = TextJoinX & y.Value & sep
End If
Next y
ElseIf IsArray(SubArr(i)) Then
For Each y In SubArr(i)
If y = "" And ign Then
Else
TextJoinX = TextJoinX & y & sep
End If
Next y
Else
If SubArr(i) = "" And ign Then
Else
TextJoinX = TextJoinX & SubArr(i) & sep
End If
End If
Next i

If Len(TextJoinX) > 0 Then _
TextJoinX = Left(TextJoinX, Len(TextJoinX) - Len(sep))

End Function

There is no misspelling in TEXTJOINX formula. Still returns with #NAME?
I will try Mike's UDF that Sergio kindly located. Will post on my success.

Thank you a lot,

Elina

 

[Eric W]

You could try putting Public in front of Function like this:

Public [COLOR=#333333]Function TextJoinX(sep As String, ign As Boolean, ParamArray SubArr() As Variant) As String[/COLOR]

although I'm starting to grasp at straws.

 

[EGname]

Good morning,
Eric, Sergio

I have tried Sergio(Mike's) version. I have got the same return #NAME?
Probably I am doing something wrong.
When I right click on sheet tab - view code - there is no code showing. Code sits in module 1, and not in: VBA project - Microsoft Objects-Sheet1. Is it the right place to have code in? I just pasted the code, do I need to save the code in addition to paste?
Its obviously I am missing something basic. Can you help me guys, please.

Thank you
Elina

 

[sergioMabres]

Hi Elina
Write clik VBAProject, add, module a modulex will be added in a modules folder, for instance module1, inside module1 should be the funtions for the sheet to use as UDF
Cheers
Sergio