UDF MLOOKUP and Remove Duplicates from an array

[Tr3yAnderson]

I've tried many options I found online without any luck. Basically I have written and Function for when doing a vlookup/index-match, if there are multiple instances of your lookup value it will loop through each instance and Concatenate each result into the cell. For example if I want to lookup based on the date 3/3/2020 there are two names associated with that date. The Function I've written can handle that portion and will return "Blake, Anderson", where it fails is if have an instance where I lookup 2/27/20, this has 4 instances of the same name. I don't want to return 4 instances of the same name but to delete the duplicates within my array. I've searched the web and found most use the Dictionary method as you'll see I have 3 of those options I've tried below. the problem is it doesn't get rid of all the duplicates. it'll make the array ("Johnson, Johnson, Johnson, Johnson") and reduce it to only ("Johnson, Johnson"). Any Ideas? I'll readily admit I don't understand the Dictionary method well enough to fully grasp what's going on. Additionally if there is a better way to even accomplish my initial task I'm open for that as well.

#	Group	Date	Name	Amount
1	10	2/27/2020	Johnson	$ 9.00
2	10	2/27/2020	Johnson	$ 47.00
3	10	2/27/2020	Johnson	$ 52.00
4	10	2/27/2020	Johnson	$ 31.00
5	10	3/2/2020	Blake	$ 56.00
6	10	3/3/2020	Blake	$ 38.00
7	10	3/3/2020	Anderson	$ 88.00
8	15	3/5/2020	Anderson	$ 80.00
9	15	3/6/2020	Anderson	$ 32.00

*Notes on the variables
Lookupvalue = the date you are initially looking for
LookupRange = the column range where the dates are in
TableRange = the entire table array
ColumnNum = the column # within the TableRange that has the name that you want to concatenate

Function MLOOKUPCONCATENATE(Lookupvalue As Long, LookupRange As Range, TableRange As Range, ColumnNum As Integer) As Variant

Dim NameCombine As String
Dim Cnt As Integer
Dim x As Integer
Dim NameString() As String
'Dim b As Boolean

Cnt = WorksheetFunction.CountIfs(LookupRange, Lookupvalue)

If WorksheetFunction.CountIfs(LookupRange, Lookupvalue) > 1 Then
NameCombine = WorksheetFunction.Index(TableRange, WorksheetFunction.Match(Lookupvalue, LookupRange, 0), ColumnNum)

For x = 2 To Cnt

NameCombine = NameCombine & ", " & WorksheetFunction.Index(TableRange, WorksheetFunction.Match(Lookupvalue, LookupRange, 0) + x - 1, ColumnNum)

Next x

NameString() = Split(NameCombine)
MLOOKUPCONCATENATE = RemoveDuplicates(NameString())

Else

NameCombine = WorksheetFunction.Index(TableRange, WorksheetFunction.Match(Lookupvalue, LookupRange, 0), ColumnNum)
MLOOKUPCONCATENATE = NameCombine

End If

End Function




Option 1
Function RemoveDupesDict(Inputarray As Variant) As Variant
Dim i As Long
Dim d As Scripting.Dictionary
Set d = New Scripting.Dictionary
With d

For i = LBound(Inputarray) To UBound(Inputarray)
If IsMissing(Replace(Inputarray(i), ",", "")) = False Then
.Item(Replace(Inputarray(i), ",", "")) = 1
End If
Next
RemoveDupesDict = .Keys
End With

End Function


Option 2
Function RemoveDuplicates(ByVal myArray As Variant) As Variant
Dim d As Object
Dim v As Variant
Dim outputArray() As Variant
Dim i As Integer
Set d = CreateObject("Scripting.Dictionary")

For i = LBound(myArray) To UBound(myArray)
d(myArray(i)) = 1
Next i
i = 0
For Each v In d.Keys()
ReDim Preserve outputArray(0 To i)
outputArray(i) = v
i = i + 1
Next v
RemoveDuplicates = outputArray

End Function

Option 3
Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String
Dim varSection As Variant
Dim sTemp As String
For Each varSection In Split(sInput, sDelimiter)
If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then
sTemp = sTemp & sDelimiter & varSection

End If

Next varSection
DeDupeString = Mid(sTemp, Len(sDelimiter) + 1)
End Function

 

[Akuini]

Instead of Dictionary try using Instr, like this:

Function MLOOKUPCONCATENATE(Lookupvalue As Long, LookupRange As Range, TableRange As Range, ColumnNum As Integer) As Variant

Dim NameCombine As String, tx As String
Dim Cnt As Integer
Dim x As Integer
'Dim NameString() As String
'Dim b As Boolean

Cnt = WorksheetFunction.CountIfs(LookupRange, Lookupvalue)
NameCombine = ", " & WorksheetFunction.Index(TableRange, WorksheetFunction.Match(Lookupvalue, LookupRange, 0), ColumnNum) & ", "

If WorksheetFunction.CountIfs(LookupRange, Lookupvalue) > 1 Then

    For x = 2 To Cnt
        tx = WorksheetFunction.Index(TableRange, WorksheetFunction.Match(Lookupvalue, LookupRange, 0) + x - 1, ColumnNum)
        If InStr(1, NameCombine, ", " & tx & ", ", 1) = 0 Then
            NameCombine = NameCombine & tx & ", "
        End If
    Next x

End If

NameCombine = Mid(NameCombine, 3)
MLOOKUPCONCATENATE = Left(NameCombine, Len(NameCombine) - 2)

End Function

 

[Tr3yAnderson]

oh That's great. Thanks so much. your reply gave me an idea to add an optional input to choose whether to remove duplicates or to keep them and it works great now. Thank you much

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.

 

[Akuini]

@Tr3yAnderson

I forgot something: Is it possible you have names with comma + space in it? Like this:

dhee - data validation, create 1 name range.xlsm
	A	B	C	D	E
1	#	Group	Date	Name	Amount
2	1	10	2/27/2020	Johnson, Clark	$ 9.00
3	2	10	2/27/2020	Johnson, Mike	$ 47.00
4	3	10	2/27/2020	Johnson	$ 52.00
5	4	10	2/27/2020	Johnson	$ 31.00
6	5	10	03/02/2020	Blake	$ 56.00
Sheet4

If yes, then we need to amend the code because it might not work correctly.

 

[mikerickson]

I've use the ConcatIf function for years to return multiple items from a list.
It mirrors the sytax of SUMIF, with additional optional arguments, Delimiter and NoDouplicates)
For the OP lay-out, if "Group" is in B2, then =ConcatIf(C:C,"2/27/20"+0,D:D,",",TRUE) will return the desired string.

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
    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

 

[Tr3yAnderson]

@Tr3yAnderson

I forgot something: Is it possible you have names with comma + space in it? Like this:

dhee - data validation, create 1 name range.xlsm
	A	B	C	D	E
1	#	Group	Date	Name	Amount
2	1	10	2/27/2020	Johnson, Clark	$ 9.00
3	2	10	2/27/2020	Johnson, Mike	$ 47.00
4	3	10	2/27/2020	Johnson	$ 52.00
5	4	10	2/27/2020	Johnson	$ 31.00
6	5	10	03/02/2020	Blake	$ 56.00
Sheet4

If yes, then we need to amend the code because it might not work correctly.

Ah that's a good point, my particular set of data for my current project didn't have that but, when I typically create my own UDF I try to make them as dynamic as possible to be useful in future projects I have. I'll have to consider that for sure

 

[Tr3yAnderson]

I've use the ConcatIf function for years to return multiple items from a list.
It mirrors the sytax of SUMIF, with additional optional arguments, Delimiter and NoDouplicates)
For the OP lay-out, if "Group" is in B2, then =ConcatIf(C:C,"2/27/20"+0,D:D,",",TRUE) will return the desired string.

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
    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

This is great and much shorter than my code. Though I'm unfamiliar with some operators you use. what is the "Imp Not" and how does that work?

 

[mikerickson]

IMP is a logical operator

True IMP True = True
True IMP False = False
False IMP True = True
False IMP False = True

The NOT is applied to the NoDupilicates argument passed to the function.