Replacement for TEXTJOIN as using Excel 2016 and need to combine data

[BradleyS]

I have a formula using TEXTJOIN that works great, but the PC I need to run it on only has Excel 2016, so it doesn't work, so I'm looking for an alternative method to achieve the same result using a formula or VBA code.

I just need to combine all the data in column B unique to each ID and show it in column C. I know it repeats for each ID, but that's OK as I'm only going to use the first one of each id anyway using a VLOOKUP.

Book1
	A	B	C
1	ID	Data	Combine data
2	2715	09/08/2022 Apple pie	09/08/2022 Apple pie 08/08/2022 Banana milkshake, Strawberry pie 07/08/2022 Banana milkshake
3	2715	08/08/2022 Banana milkshake, Strawberry pie	09/08/2022 Apple pie 08/08/2022 Banana milkshake, Strawberry pie 07/08/2022 Banana milkshake
4	2715	07/08/2022 Banana milkshake	09/08/2022 Apple pie 08/08/2022 Banana milkshake, Strawberry pie 07/08/2022 Banana milkshake
5	19478	02/08/2022 Brownie, Banana milkshake, Cherry pie, Strawberry pie	02/08/2022 Brownie, Banana milkshake, Cherry pie, Strawberry pie 03/08/2022 Brownie, Cherry pie 04/08/2022 Cherry pie
6	19478	03/08/2022 Brownie, Cherry pie	02/08/2022 Brownie, Banana milkshake, Cherry pie, Strawberry pie 03/08/2022 Brownie, Cherry pie 04/08/2022 Cherry pie
7	19478	04/08/2022 Cherry pie	02/08/2022 Brownie, Banana milkshake, Cherry pie, Strawberry pie 03/08/2022 Brownie, Cherry pie 04/08/2022 Cherry pie
Sheet1

Cell Formulas
Range	Formula
C2:C7	C2	=TEXTJOIN(CHAR(10),TRUE,IF(A2=$A$2:$A$7,$B$2:$B$7,""))

 

[nemmi69]

Can try using CONCAT which is still in use

 

[Fluff]

Can try using CONCAT which is still in use

That function does not exist in 2016 either.

 

[BradleyS]

In the end I came up with this. I hope it helps someone else.

Private Sub CombineData()
   
    'Get active worksheet name
    Dim sName As String
        sName = ActiveSheet.Name
     
    Const dFirstCellAddress As String = "I2"
   
    ' Source range to an array.
   
    Dim Data As Variant
    Dim rCount As Long
   
    With ThisWorkbook.Worksheets(sName).Range("A1").CurrentRegion
        rCount = .Rows.Count - 1
        If rCount < 1 Then Exit Sub ' no data or only headers
        Data = .Resize(rCount, 7).Offset(1).Value
    End With
   
    ' Array to a dictionary of dictionaries.
   
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
   
    Dim Key As Variant
    Dim Item As Variant
    Dim r As Long
    Dim n As Long
   
    For r = 1 To rCount
        Item = CStr(Data(r, 7))
        If Not IsError(Item) Then
            If Len(Item) > 0 Then
                Key = Data(r, 1)
                If Not IsError(Key) Then
                    If Len(Key) > 0 Then
                        If Not dict.Exists(Key) Then
                            Set dict(Key) = CreateObject("Scripting.Dictionary")
                        End If
                        For n = 0 To 7
                            dict(Key)(Item) = Empty
                        Next n
                    End If
                End If
            End If
        End If
    Next r

    rCount = dict.Count
    If rCount = 0 Then Exit Sub ' only error values or blanks
    
    ' Dictionary of dictionaries to the array.
   
    ReDim Data(1 To rCount, 1 To 2)
    r = 0
   
    For Each Key In dict.Keys
        r = r + 1
        Data(r, 1) = Key
        Data(r, 2) = Join(dict(Key).Keys, vbNewLine)
    Next Key
   
    ' Array to the destination range.
   
    With ThisWorkbook.Worksheets(sName).Range(dFirstCellAddress).Resize(, 2)
        .Resize(rCount).Value = Data
        .Resize(.Worksheet.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
    End With

    'MsgBox "Data combined.", vbInformation

End Sub

 

[Fluff]

Glad you sorted it & thanks for letting us know.