VBA UDF: Count Unique Values with Optional Multiple Criteria

[jrichmeier1]

Hello,

I'm coming here for help on a UDF to count unique values with (optional) multiple criteria. I've pieced together the following code but am having trouble getting it to work (it throws a #VALUE error each time).

Is there a way to get this code to work?

Function CountUniques(CountItems As Range, Optional LookupRange_1 As Range, Optional Criteria_1 As Variant, Optional LookupRange_2 As Range, Optional Criteria_2 As Variant) As Long
'Example:  =CountUniques(A:A,B:B,1,C:C,2)

Dim Record As Variant
Dim Results As Long
Results = 0

For Each Record In CountItems
    If Cells(Record.Row, Record.Column) <> Cells(Record.Row - 1, Record.Column) Then
        If Cells(Record.Row, LookupRange_1.Column) = Criteria_1 Then
            If Cells(Record.Row, LookupRange_2.Column) = Criteria_2 Then
                Results = Results + 1
            End If
        End If
    End If
Next Record

CountUniques = Results
End Function

<svg class="SnapLinksHighlighter" xmlns="http://www.w3.org/2000/svg"> <rect width="0" height="0"></rect> <!-- Used for easily cloning the properly namespaced rect --> </svg>

 

[offthelip]

change

[COLOR=#333333]Dim Record As Variant[/COLOR]

to

Dim Record As Range

 

[Domenic]

With your sample formula, the range object Record is assigned cell A1 during the first iteration of the For Each/Next loop. As a result, Record.Row - 1 returns 0. And so Cells(Record.Row - 1, Record.Column) causes an error. Before entering the For Each/Next loop, try re-defining CountItems as follows...

With CountItems
    Set CountItems = Application.Intersect(.Worksheet.UsedRange, .Resize(.Count - 1).Offset(1, 0))

End With

This will offset the range one row down from its original location, and only for the used range so that you don't have to deal with the whole column.

Hope this helps!