UDF MLOOKUP and Remove Duplicates from an array

Tr3yAnderson

New Member
Joined
Aug 31, 2015
Messages
16
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.

#GroupDateName Amount
1102/27/2020Johnson $ 9.00
2102/27/2020Johnson $ 47.00
3102/27/2020Johnson $ 52.00
4102/27/2020Johnson $ 31.00
5103/2/2020Blake $ 56.00
6103/3/2020Blake $ 38.00
7103/3/2020Anderson $ 88.00
8153/5/2020Anderson $ 80.00
9153/6/2020Anderson $ 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
 

Some videos you may like

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,953
Office Version
  1. 365
Platform
  1. Windows
Instead of Dictionary try using Instr, like this:
VBA Code:
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

New Member
Joined
Aug 31, 2015
Messages
16
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

Well-known Member
Joined
Feb 1, 2016
Messages
2,953
Office Version
  1. 365
Platform
  1. Windows
You're welcome, glad to help, & thanks for the feedback.:)
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,953
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

@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
ABCDE
1#GroupDateNameAmount
21102/27/2020Johnson, Clark$ 9.00
32102/27/2020Johnson, Mike$ 47.00
43102/27/2020Johnson$ 52.00
54102/27/2020Johnson$ 31.00
651003/02/2020Blake$ 56.00
Sheet4


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

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,949
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.

VBA Code:
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

New Member
Joined
Aug 31, 2015
Messages
16

ADVERTISEMENT

@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
ABCDE
1#GroupDateNameAmount
21102/27/2020Johnson, Clark$ 9.00
32102/27/2020Johnson, Mike$ 47.00
43102/27/2020Johnson$ 52.00
54102/27/2020Johnson$ 31.00
651003/02/2020Blake$ 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

New Member
Joined
Aug 31, 2015
Messages
16
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.

VBA Code:
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

MrExcel MVP
Joined
Jan 15, 2007
Messages
23,949
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,965
Messages
5,621,871
Members
415,862
Latest member
nascaline

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top