Heavy custom function

[tiagokrug]

Hello everyone!

Suppose I have the following range:

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Project Name[/TD]
[TD]Color[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD]yellow[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD]green[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD]red[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD]green[/TD]
[/TR]
[TR]
[TD]Project A[/TD]
[TD]green[/TD]
[/TR]
[TR]
[TD]Project B[/TD]
[TD]blue[/TD]
[/TR]
[TR]
[TD]Project B[/TD]
[TD]yellow[/TD]
[/TR]
[TR]
[TD]Project B[/TD]
[TD]yellow[/TD]
[/TR]
[TR]
[TD]Project B[/TD]
[TD]blue[/TD]
[/TR]
</tbody>[/TABLE]

I would like to code a custom function that check the first column according to a given criteria and count the number of different colors in the second column. For example, the number of different colors of "Project A" is 3 (yellow, green and red).

I managed to do the folowing function:

Function COUNT_DATA(criteria As String, CritRange As Variant, DataRange As Variant)
Dim i As Long
Dim MyArray() As Variant
Dim N As Long
Dim verify As Variant


N = 0
ReDim MyArray(N)


For i = LBound(CritRange.Value) To UBound(CritRange.Value)
If CritRange(i, 1) = criteria Then

verify = Application.match(DataRange(i, 1), MyArray, 0)


If IsError(verify) Then
ReDim Preserve MyArray(N)
MyArray(N) = DataRange(i, 1)
N = N + 1
End If

End If
Next i


COUNT_DATA = N


End Function

The function is working, but it gets so heavy to calculate when I select a entire range, example: =COUNT_DATA(A6;A:A;B:B)

The built-in worksheets functions, like COUNTIF or VLOOKUP doesn't take any time for calculating when I select entire ranges. Why is this happening? What I'm doing wrong?

Is there a way to view the built-in functions in VBA language, just to learn a little bit more?

Thanks!

 

[Jerry Sullivan]

The built-in worksheets functions, like COUNTIF or VLOOKUP doesn't take any time for calculating when I select entire ranges. Why is this happening? What I'm doing wrong?

Hi and Welcome to the Board,

Some native Excel functions (like Countif) are efficient at working with entire column/ entire row ranges, because they only look at the part of the entire column/row that intersects the UsedRange.

You could improve the speed of your custom worksheet function by doing that as a first step.

Is there a way to view the built-in functions in VBA language, just to learn a little bit more?

If you are asking whether there is a way to view the inner workings of a function like Countif in VBA, then as far as I know that isn't possible.
The built in functions are not written in VBA, and I presume that the algorithms used are proprietary.

On the other hand, you could put a breakpoint in your UDF and then use the F8 key to step through your code to see how it will try to continue down the entire column even if your used range is only a few rows.

 

[diddi]

your bottleneck is at the Redim Preserve statement. it is notoriuosly slow and should be avoided if possible. you are better having a temporary array, and then copying it to a new one, if the upperbound is important.

 

[tiagokrug]

First of all, thank you guys for the answers.

I'm not an expert user of VBA (it's a lot of Google search for each code!). Could you post some examples?

 

[Jerry Sullivan]

First of all, thank you guys for the answers.

I'm not an expert user of VBA (it's a lot of Google search for each code!). Could you post some examples?

You could implement the suggestion to exclude items in your lookup that are outside the UsedRange by merely adding this line to your code before your For...Next loop.

[COLOR="#0000CD"][B]    Set CritRange = Intersect(CritRange, CritRange.Parent.UsedRange)[/B][/COLOR]
    
    For i = LBound(CritRange.Value) To UBound(CritRange.Value)

Here is a rewritten version that further limits the lookup to the data range within the lookup column.

Function COUNT_DATA(sLookup As String, rCrit As Range, rData As Range)  
    Dim i As Long, N As Long
    Dim vUnique() As Variant

    
    If rCrit.Columns.Count > 1 Or rData.Columns.Count > 1 Then
        COUNT_DATA = CVErr(xlErrNA)
    Else
        '--resize to data range within referenced range
        If rCrit.Count > 1 Then
            With rCrit
                If .Cells(.Cells.Count) = "" Then Set rCrit = Range(.Cells(1), _
                    .Cells(.Cells.Count).End(xlUp))
            End With
            With rCrit
                If .Cells(1) = "" Then Set rCrit = Range(rCrit(1).End(xlDown), .Cells(.Cells.Count))
            End With
        End If

    
        If Not rCrit Is Nothing Then
            ReDim vUnique(rCrit.Count)
            On Error Resume Next
            For i = 1 To rCrit.Count
                If rCrit(i) = sLookup Then
                    If IsError(Application.Match(rData(i), vUnique, 0)) Then
                        vUnique(N) = rData(i)
                        N = N + 1
                    End If
                End If
            Next i
            On Error GoTo 0
        End If
        COUNT_DATA = N
    End If
 End Function

This version also incorporates Didi's suggestion and avoids Redim Preserve by oversizing the array. While it's correct that this is more efficient than having Redim Preserve inside the loop; the savings from this technique are negligible compared to those from limiting the lookup to the data range when one uses entire column references.

It's worth noting that your task can also be accomplished with formulas alone. See this thread for examples.
http://www.mrexcel.com/forum/excel-questions/589017-count-unique-values-specific-criteria.html

In testing UDF and the formulas on a specific dataset (10,000 records with 1000 unique Project Names averaging 11 unique Colors) the UDF recalculated significantly faster.

If you have a very large dataset, you might consider using a PivotTable with an SQL Query datasource which would could be refreshed much more quickly than the recalculation required for UDF or formula approaches.

 

[tiagokrug]

The function is very fast now! Thanks Jerry!