4

I am trying to utilize a UDF version of TextJoin since I am using Excel 2013 - but this function is not properly returning the accurate data.

My data-set in Excel looks like this

saleID      Item
5           PRE2323
6           Pre2323223
6           OX12321
6           RI132
9           TN23
9           LSR12

And my desired output is

saleID     Items
5          Pre2323
6          Pre2323223, OX12321, RI132
9          TN23, LSR12

And this is the UDF I Have that is not functioning as it should

    Option Explicit
Function TEXTJOIN(delimiter As String, ignore_empty As String, ParamArray textn() As Variant) As String
    Dim i As Long
    For i = LBound(textn) To UBound(textn) - 1
        If Len(textn(i)) = 0 Then
            If Not ignore_empty = True Then
                TEXTJOIN = TEXTJOIN & textn(i) & delimiter
            End If
        Else
            TEXTJOIN = TEXTJOIN & textn(i) & delimiter
        End If
    Next
    TEXTJOIN = TEXTJOIN & textn(UBound(textn))
End Function

And I am calling it in the cell like this

=TEXTJOIN(", ",1,INDEX(REPT(B$2:B$100,A$2:A$100=ROWS(C$2:C2)),0))

And I get an error of #VALUE!

Gowtham Shiva
  • 3,802
  • 2
  • 11
  • 27
Smith Stanley
  • 461
  • 1
  • 8
  • 25

4 Answers4

8

This function accepts both ranges and arrays, both horizontal and vertical

Function TEXTJOIN(delim As String, skipblank As Boolean, arr)
    Dim d As Long
    Dim c As Long
    Dim arr2()
    Dim t As Long, y As Long
    t = -1
    y = -1
    If TypeName(arr) = "Range" Then
        arr2 = arr.Value
    Else
        arr2 = arr
    End If
    On Error Resume Next
    t = UBound(arr2, 2)
    y = UBound(arr2, 1)
    On Error GoTo 0

    If t >= 0 And y >= 0 Then
        For c = LBound(arr2, 1) To UBound(arr2, 1)
            For d = LBound(arr2, 1) To UBound(arr2, 2)
                If arr2(c, d) <> "" Or Not skipblank Then
                    TEXTJOIN = TEXTJOIN & arr2(c, d) & delim
                End If
            Next d
        Next c
    Else
        For c = LBound(arr2) To UBound(arr2)
            If arr2(c) <> "" Or Not skipblank Then
                TEXTJOIN = TEXTJOIN & arr2(c) & delim
            End If
        Next c
    End If
    TEXTJOIN = Left(TEXTJOIN, Len(TEXTJOIN) - Len(delim))
End Function

In this instance you would use it as an array formula:

=TEXTJOIN(", ",TRUE,IF($A$2:$A$10=D2,$B$2:$B$10,""))

Being an array formula it would need to be confirmed with Ctrl-Shift-Enter instead of Enter when exiting edit mode.

enter image description here

Scott Craner
  • 148,073
  • 10
  • 49
  • 81
2

If your data is in columns A and B, this code should work.

Sub TEXTJOIN()
Dim i As Long, str As String, k As Long
Columns("A:B").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes
str = Cells(2, 2)
k = 2
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) = Cells(i + 1, 1) Then
        str = str & "," & Cells(i + 1, 2)
    Else
        Cells(k, 4) = Cells(i, 1)
        Cells(k, 5) = str
        k = k + 1
        str = Cells(i + 1, 2)
    End If
Next i
End Sub

enter image description here

I leave the part to you to convert this to an UDF.

Gowtham Shiva
  • 3,802
  • 2
  • 11
  • 27
  • I must be missing something here. I changed it to a Public Function TextJoin() and in cell D2 I input TextJoin() but it always returns 0? What I see in the code is you are comparing the value of i,1 and i+1, 1 (so example would be A2, and B2) and if the values match then append then with a comma between them. – Smith Stanley Aug 23 '17 at 16:16
  • 1
    @SmithStanley if you use it as a UDF, you may need to return the values to corresponding range. Not just by entering the UDF in `one cell`. You may use it as it is as i posted – Gowtham Shiva Aug 23 '17 at 16:20
2

You may try something like this...

Function TEXTJOIN(delimiter As String, lookup_id As Range, arr_rng As Range, Optional ignore_empty As Boolean = True) As String
Dim x, dict
Dim i As Long
x = arr_rng.Value
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(x, 1)
    If x(i, 1) = lookup_id Then
        If Not dict.exists(x(i, 1)) Then
            dict.Item(x(i, 1)) = x(i, 2)
        Else
            dict.Item(x(i, 1)) = dict.Item(x(i, 1)) & IIf(x(i, 2) = "", IIf(ignore_empty, "", delimiter), delimiter & x(i, 2))
        End If
    End If
Next i
If dict.Count > 0 Then
    TEXTJOIN = dict.Item(IIf(IsNumeric(lookup_id), lookup_id + 0, lookup_id))
Else
    TEXTJOIN = ""
End If
End Function

Then considering your data is in range A2:B7, try this like below...

In C2

=TEXTJOIN(",",A2,$A$2:$B$7)

enter image description here

Subodh Tiwari sktneer
  • 9,906
  • 2
  • 18
  • 22
0

Try this....!

Function TEXTJOIN(delimiter As String, ignore_empty As Boolean, ParamArray 
cell_ar() As Variant)
2
For Each cellrng In cell_ar
3
For Each cell In cellrng
4
If ignore_empty = False Then
5
result = result & cell & delimiter
6
Else
7
If cell <> "" Then
8
result = result & cell & delimiter
9
End If
10
End If
11
Next cell
12
Next cellrng
13
TEXTJOIN = Left(result, Len(result) - Len(delimiter))
14
End Function
HUMENTH
  • 1
  • 2
  • Welcome to StackOverflow. Answers with only code in them tend to get flagged for deletion as they are "low quality". Please read the help section on answering questions then consider adding some commentary to your Answer. – Graham Mar 07 '18 at 06:01