extract unique entries based on two criterias

[Biz]

Hi Peter,
I saw your solution using TextJoin, but I have an older version of Excel. Do you have Excel UDF which can replicate TextJoin and can get the same result as post 12.

kind Regards
Biz

 

[snjpverma]

Hi Peter,
I saw your solution using TextJoin, but I have an older version of Excel. Do you have Excel UDF which can replicate TextJoin and can get the same result as post 12.

kind Regards
Biz

click the below link:
Alternate for Textjoin

 

[Biz]

click the below link:
Alternate for Textjoin

Hi,

It doesn't work.

Biz

 

[Peter_SSs]

Hi Peter,
I saw your solution using TextJoin, but I have an older version of Excel. Do you have Excel UDF which can replicate TextJoin and can get the same result as post 12.

Try this one. It has the option of providing a minimum requirement other than 2 as shown in A14 & A15 below.

Function LessThanMin(rData As Range, Optional LTMin As Long = 2) As String
  Dim d As Object
  Dim a As Variant, itm As Variant
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Evaluate(rData.Columns(1).Address & "&""-""&" & rData.Columns(2).Address)
  For Each itm In a
    d(itm) = d(itm) + 1
  Next itm
  For Each itm In d.keys
    If d(itm) >= LTMin Then d.Remove itm
  Next itm
  If Len(Join(d.keys, ", ")) = 0 Then
    LessThanMin = "Everybody met the requirement of minimum " & LTMin & " submissions"
  Else
    LessThanMin = "The following people have not met the requirement of minimum " & LTMin & " submissions: " & Join(d.keys, ", ")
  End If
End Function

Biz.xlsm
	A	B
1	Sales peron	Emp ID
2	Jack	15
3	Bob	12
4	Luke	23
5	Jack	15
6	Luke	30
7	James	25
8	Bob	12
9	Ali	88
10	Jack	15
11
12
13	The following people have not met the requirement of minimum 2 submissions: Luke-23, Luke-30, James-25, Ali-88
14	The following people have not met the requirement of minimum 3 submissions: Bob-12, Luke-23, Luke-30, James-25, Ali-88
15	Everybody met the requirement of minimum 1 submissions
Make list

Cell Formulas
Range	Formula
A13	A13	=LessThanMin(A2:B10)
A14	A14	=LessThanMin(A2:B10,3)
A15	A15	=LessThanMin(A3:B11,1)

 

[Biz]

Hi Peter,

Thank you very much for your help.

I found a code and it works like TextJoin formula except I neeed to CSE. Is it possible to make this UDF work with CSE?

Function TextJoin_20(Delimiter As String, Ignore_Emtpy As Boolean, ParamArray args() As Variant) As Variant
    Dim results As String
    Dim count As Long, i As Long, j As Long, length As Long, pos As Long
    Dim argument As Variant, v As Variant
    

    Select Case TypeName(args(0))
    
        Case "Empty"
            argument = Array()
        Case "Range"
            If args(0).count = 1 Then
                argument = Array(args(0).Value)
            Else
                argument = args(0).Value
            End If
        Case "String"
            argument = Array(args(0))
        Case "Variant()"
            argument = args(0)
    End Select

    For Each v In argument
        length = length + Len(v)
        count = count + 1
    Next
    
    
    results = Space(length + count * Len(Delimiter))
    If count - 1 + LBound(argument) = UBound(argument) Then
        For Each v In argument
            If Not Ignore_Emtpy Or Len(v) > 0 Then
                Mid(results, pos + 1, Len(v) + Len(Delimiter)) = v & Delimiter
                pos = pos + Len(v) + Len(Delimiter)
            End If
        Next
    Else
        For i = LBound(argument) To UBound(argument)
            For j = LBound(argument, 2) To UBound(argument, 2)
                If Not Ignore_Emtpy Or Len(argument(i, j)) > 0 Then
                    Mid(results, pos + 1, Len(argument(i, j)) + Len(Delimiter)) = argument(i, j) & Delimiter
                    pos = pos + Len(argument(i, j)) + Len(Delimiter)
                End If
            Next
        Next
    End If
    
    'Trim results needed to adjust for skipping empty values
    results = Left(results, pos)
    
    For i = 1 To UBound(args)
        results = results & TextJoin_20(Delimiter, Ignore_Emtpy, args(i)) & Delimiter
    Next
    
    Debug.Print Left(results, Len(results) - Len(Delimiter))
    TextJoin_20 = Left(results, Len(results) - Len(Delimiter))
End Function

Kind Regards,

Biz

 

[Peter_SSs]

Difficult reading and interpreting somebody else's code, especially with no context.
It might be more useful if you told us, with examples and expected results, exactly what you have and what you are trying to achieve.

Didn't my UDF above do what you asked?

UDF which can replicate TextJoin and can get the same result as post 12.

 

[Biz]

Your code works but I wanted to use the same criteria as you are using in native TextJoin function. The UDF works in post 5 works with criteria you used native TextJoin formula except it needs CSE.

 

[Peter_SSs]

Sorry, I don't understand.
I don't know what you have in your worksheet or what you are trying to achieve.

 

[Biz]

Hi Peter,

Please find below an extract.

Extract unique entries based on two criterias v2.xlsm
	A	B	C	D	E	F	G	H	I
1	Sales peron	Emp ID	Profits earned	Dates	Store
2	Jack	15	20957	42798	East
3	Bob	12	56323	43222	West
4	Luke	23	31892	43350	West
5	Jack	15	55224	10/15/2018	East
6	Luke	30	27937	8/29/2019	West
7	James	25	35356	1/25/2022	East
8	Bob	12	29117	5/30/2022	West
9	Ali	88	41665	10/23/2022	East
10	Jack	15	29451	44603
11
12
13	#NAME?							Should Be	Works only CSE
14							#VALUE!	Luke-23,Luke-30,James-25,Ali-88	Luke-23,Luke-30,James-25,Ali-88
Sheet1

Cell Formulas
Range	Formula
A13	A13	="The following people have not met the requirement of minimum two submissions: "&TEXTJOIN(",",1,IF(COUNTIF(B2:B10,B2:B10)=1,A2:A10&"-"&B2:B10,""))
G14	G14	=TEXTJOIN_20(",",1,IF(COUNTIF(B2:B10,B2:B10)=1,A2:A10&"-"&B2:B10,""))
I14	I14	=TEXTJOIN_20(",",1,IF(COUNTIF(B2:B10,B2:B10)=1,A2:A10&"-"&B2:B10,""))
Press CTRL+SHIFT+ENTER to enter array formulas.

In Cell G14, I'm using TextJoin_20 UDF and trying to use the same criteria as used by you in Excel 365 TextJoin funtion, but it fails. My should be cell H14, but UDF only works using CSE (cell I14).

Is it possible to derive the same solution using UDF below without using CSE?

Function TextJoin_20(Delimiter As String, Ignore_Emtpy As Boolean, ParamArray args() As Variant)
    Dim results As String
    Dim count As Long, I As Long, j As Long, length As Long, pos As Long
    Dim argument As Variant, v As Variant
      
1     Select Case TypeName(args(0))
          Case "Empty"
2             argument = Array()
3         Case "Range"
4             If args(0).count = 1 Then
5                 argument = Array(args(0).Value)
6             Else
7                 argument = args(0).Value
8             End If
9         Case "String"
10            argument = Array(args(0))
11        Case "Variant()"
12            argument = args(0)
13    End Select
        
14    For Each v In argument
15        length = length + Len(v)
16        count = count + 1
        Next
        
17    results = Space(length + count * Len(Delimiter))
18    If count - 1 + LBound(argument) = UBound(argument) Then
19        For Each v In argument
20            If Not Ignore_Emtpy Or Len(v) > 0 Then
21                Mid(results, pos + 1, Len(v) + Len(Delimiter)) = v & Delimiter
22                pos = pos + Len(v) + Len(Delimiter)
23            End If
24        Next
        Else
25        For I = LBound(argument) To UBound(argument)
26            For j = LBound(argument, 2) To UBound(argument, 2)
27                If Not Ignore_Emtpy Or Len(argument(I, j)) > 0 Then
28                    Mid(results, pos + 1, Len(argument(I, j)) + Len(Delimiter)) = argument(I, j) & Delimiter
29                    pos = pos + Len(argument(I, j)) + Len(Delimiter)
30                End If
31            Next
32        Next
33    End If
        
        'Trim results needed to adjust for skipping empty values
34    results = Left(results, pos)
        
35    For I = 1 To UBound(args)
36        results = results & TextJoin_20(Delimiter, Ignore_Emtpy, args(I)) & Delimiter
        Next
        
37    Debug.Print Left(results, Len(results) - Len(Delimiter))
38    TextJoin_20 = Left(results, Len(results) - Len(Delimiter))
End Function

Hope my question how makes more sense.

Kind Regards,

Biz

 

[Peter_SSs]

Hope my question how makes more sense.

I think so

You say ..

Is it possible to derive the same solution using UDF below without using CSE?

.. but earlier you said this

Is it possible to make this UDF work with CSE?

I don't think so since you are trying to feed an array into the function and your version of Excel requires the CSE to do that.

Why are you stuck on that UDF?
How critical is being able to specify the delimiter? (my function can be amended to include that)
How critical is it to have the "Ignore Empty" setting? I note that there are no empty rows in the sample data. If this setting is critical, can you provide some sample data and expected results that demonstrate such a situation?

Here is at least a part-way modification of my earlier function that you could evaluate.
This has a default count of 1 and delimiter of comma but you can change either of these in the formula using the second and third arguments - see cell H18

Function LessThanMin(rData As Range, Optional CountRequired As Long = 1, Optional Delim As String = ",") As String
  Dim d As Object
  Dim a As Variant, itm As Variant
  
  Set d = CreateObject("Scripting.Dictionary")
  a = Evaluate(rData.Columns(1).Address & "&""-""&" & rData.Columns(2).Address)
  For Each itm In a
    d(itm) = d(itm) + 1
  Next itm
  For Each itm In d.keys
    If d(itm) <> CountRequired Then d.Remove itm
  Next itm
  LessThanMin = Join(d.keys, Delim)
End Function

Biz.xlsm
	A	B						H
2	Jack	15
3	Bob	12
4	Luke	23
5	Jack	15
6	Luke	30
7	James	25
8	Ken	3
9	Ken	3
10	Bob	12
11	Ali	88
12	Jack	15
13
14
15								Should Be
16								Luke-23,Luke-30,James-25,Ali-88
17								Luke-23,Luke-30,James-25,Ali-88
18								Bob-12 <-> Ken-3
Sheet1

Cell Formulas
Range	Formula
H17	H17	=LessThanMin(A2:B12)
H18	H18	=LessThanMin(A2:B12,2," <-> ")