Using ConcatenateIf function trying to remove duplicates

[nmganey]

I have an excel sheet that has page numbers, Categories, and item numbers. I want to make almost an index of the Category then unique page numbers this is the code I am using now I need to find out were to add to remove the Dups.

Function ConcatenateIf(CriteriaRange As Range, Condition As Variant, ConcatenateRange As Range, Optional Separator As String = ",") As Variant

Dim xResult As String
Dim i as integer

On Error Resume Next
If CriteriaRange.Count <> ConcatenateRange.Count Then
ConcatenateIf = CVErr(xlErrRef)
Exit Function
End If
For i = 1 To CriteriaRange.Count
If CriteriaRange.Cells(i).Value = Condition Then
xResult = xResult & Separator & ConcatenateRange.Cells(i).Value
End If
Next i
If xResult <> "" Then
xResult = VBA.Mid(xResult, VBA.Len(Separator) + 1)
End If
ConcatenateIf = xResult
Exit Function
End Function


then in my cell my formula is

=CONCATENATEIF($A$2:$A$15, D2, $B$2:$B$15, ",")

 

[FDibbins]

This formula will generate a list of unique entries, no VBA needed...
=IFERROR(INDEX($B$50:$B$74,MATCH(0,INDEX(COUNTIF($E$49:E49,$B$50:$B$74),),0)),"")
where $B$50:$B$74 is the data you want returned
$E$49:E49,creates the list to count

 

[nmganey]

I put in the formula as follows;

=iferror(index(Sheet1!$A$1:$A$7520,MATCH(0,INDEX(COUNTIF(Sheet1!$B1:$7520,Sheet1!$A$1:$A$7520),),0)),"")
$A$1:$A$7520 = PAGE #
$B$1:$B$7520 = Categories

It only returns 1 page number I am looking for it to return all the page numbers that have the same Categories for example

apples 2,5,6,9,11,12,14,16,18,21,22,59,68
grapes 1,2,3,4,7,10,13,15,17

 

[mikerickson]

My ConcatIf function has a NoDuplicates boolean argument

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

 

[nmganey]

My ConcatIf function has a NoDuplicates boolean argument

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

I get #Name? when I put the formula =CONCATENATEIF($B$2:$B$15, SHEET1!A2, $A$2:$A$15, ",")

 

[mikerickson]

My function is named ConcatIf, not ConcatenateIf. Its an old UDF that I keep at hand, not an adaptation of the OP code.

The formula would be
=CONCATIF($B$2:$B$15, SHEET1!A2, $A$2:$A$15, ",", TRUE)

 

[nmganey]

Great!!!! Thanks that worked Outstandingly!!!

 

[Fredek]

Hi mikerickson,

I used the code you wrote for nmganey, it works at concatenating, however it does not seem to exclude dupes. Any idea why? Do I have to have to add anything to get rid of the dupes?

[TABLE="width: 201"]
<tbody>[TR]
[TD]Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
[/TD]
[/TR]
[TR]
[TD]    Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
[/TD]
[/TR]
[TR]
[TD]    Dim i As Long, j As Long
[/TD]
[/TR]
[TR]
[TD]    With compareRange.Parent
[/TD]
[/TR]
[TR]
[TD]        Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
[/TD]
[/TR]
[TR]
[TD]    End With
[/TD]
[/TR]
[TR]
[TD]    If compareRange Is Nothing Then Exit Function
[/TD]
[/TR]
[TR]
[TD]    If stringsRange Is Nothing Then Set stringsRange = compareRange
[/TD]
[/TR]
[TR]
[TD]    Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
[/TD]
[/TR]
[TR]
[TD]    stringsRange.Column - compareRange.Column)
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]    For i = 1 To compareRange.Rows.Count
[/TD]
[/TR]
[TR]
[TD]        For j = 1 To compareRange.Columns.Count
[/TD]
[/TR]
[TR]
[TD]            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
[/TD]
[/TR]
[TR]
[TD]                If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
[/TD]
[/TR]
[TR]
[TD]                    ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
[/TD]
[/TR]
[TR]
[TD]                End If
[/TD]
[/TR]
[TR]
[TD]            End If
[/TD]
[/TR]
[TR]
[TD]        Next j
[/TD]
[/TR]
[TR]
[TD]    Next i
[/TD]
[/TR]
[TR]
[TD]    ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
[/TD]
[/TR]
[TR]
[TD]End Function
[/TD]
[/TR]
</tbody>[/TABLE]

Thanks,
Fred

 

[Fredek]

Apologies, I just realised the True/False at the end of the formula switches the dupes off.

Thanks!

 

[overclock]

My ConcatIf function has a NoDuplicates boolean argument

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

Thank you for sharing. This concatif UDF is faster than the one running around the internet. Is it possible to have the function alphabetize the results taking into account the results can be number and alpha characters?

I couldn't figure out how to PM you so hopefully you see my reply/question.