textjoin() for 2010 VBA

[dmj120]

I have read several posts (here and other sites), and knowing VERY little about VBA, I thought I'd reach out. I found the perfect solution from Excelisfun's youtube videos (magic trick 1282), which references Mr.Excel Member DRSteele's post:

	{=TEXTJOIN("; ",1,REPT($B$1:$B$8,1*($A$1:$A$8=A$11)))}

Can someone help me with how to create a UDF using VBA?

I need to join the items in column B that equal a referenced cell in column A. There will be multiple returns of the same item in column B, but I only need on of each.

Column A	Column B
Active	Full
Active	Full
Removed	none
Active	partial
Active	partial
Active	inventory
Result for Active
Full, partial, inventory

 

[Eric W]

Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste this code into the sheet that opens:

Public Function TxtJoinUniq(r1 As Range, r2 As Range, mtch As String, delim As String)

    If r1.Rows.Count <> r2.Rows.Count Then
        TxtJoinUniq = "Mismatched range sizes"
        Exit Function
    End If
    a1 = r1.Value
    a2 = r2.Value

    For i = 1 To UBound(a1)
        If LCase(a1(i, 1)) = LCase(mtch) Then
            If InStr(TxtJoinUniq, delim & a2(i, 1)) = 0 Then
                TxtJoinUniq = TxtJoinUniq & delim & a2(i, 1)
            End If
        End If
    Next i
        
    TxtJoinUniq = Mid(TxtJoinUniq, Len(delim) + 1)
    
End Function

Press Alt-Q to close the editor. Then you can use the new function as follows:

Book1
	A	B
1	Active	Full
2	Active	Full
3	Removed	none
4	Active	partial
5	Active	partial
6	Active	inventory
7
8
9	Result for:	active
10	Full, partial, inventory
Sheet7

Cell Formulas
Range	Formula
A10	A10	=txtjoinuniq(A1:A8,B1:B8,B9,", ")

 

[dmj120]

Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste this code into the sheet that opens:

Works PERFECTLY - thank you!!!! ?

 

[Eric W]

Happy to help! Thanks for the feedback!

 

[Rick Rothstein]

Here is another way to write the function (which I chose to call JoinIfUniq since I thought it described what it is doing more accurately)...

Function JoinIfUniq(TestRng As Range, ResultRng As Range, Match As String, Delim As String) As String
  Dim R As Long, ArrTest As Variant, ArrResult As Variant
  ArrTest = TestRng.Value
  ArrResult = ResultRng.Value
  If UBound(ArrTest) = UBound(ArrResult) Then
    With CreateObject("Scripting.Dictionary")
      For R = 1 To UBound(ArrTest)
        If LCase(ArrTest(R, 1)) = LCase(Match) Then .Item(StrConv(ArrResult(R, 1), vbProperCase)) = 1
      Next
      JoinIfUniq = Join(.Keys, Delim)
    End With
  Else
    JoinIfUniq = "Ranges_Mismatch_Error"
  End If
End Function

 

[dmj120]

Here is another way to write the function (which I chose to call JoinIfUniq since I thought it described what it is doing more accurately)...

Thanks! I am thinking about adding the pricing column, do do the same function, so I may try to 'play' with this

 

[dmj120]

Here is another way to write the function (which I chose to call JoinIfUniq since I thought it described what it is doing more accurately)...

Is it possible to count the number of multiple items, instead of listing them? I think this would be easier for the pricing column.

 

[Rick Rothstein]

Are you asking for how many item are in the "unique" list (that is, the number of items outputted in the list from the function I posted in Message #5)? Or are you asking for something else?

 

[dmj120]

Are you asking for how many item are in the "unique" list (that is, the number of items outputted in the list from the function I posted in Message #5)? Or are you asking for something else?

Yes, it'd be the same, but instead of listing the unique items, it would simple return how many unquie values were hound.