ColorFunction UDF

Question

Hi I have tried 3 different types of colorfunction UDF that are available online for my Excel 2013. However it keeps crashing every time I refresh etc... there was a fix to stop this (for excel to refresh it only if done manually)

This is the code:

    Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult

    lCol = rColor.Interior.ColorIndex
    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.SUM(rCell,vResult)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If
   ColorFunction = vResult
End Function

Please help as this is getting really annoying, my whole computer crashes...

Could this be put into a macro that I can run manually? would that solve it?

Extra information - running windows 8.1... Office 2013... Ive already tried running on three different computers all the same, the same also happened on 2010 version of office on windows 7. Just crashes excel trying to update (possibly too many records but they contain around 100 rows, which should be ok?)

---

tried the following which also crashes excel. Just says CALCULATING( 3 PRCOESSOR(S)); 0%

    Function CountCellsByColor(rData As Range, cellRefColor As Range) As Long
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim cntRes As Long

    Application.Volatile
    cntRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Interior.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Interior.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent

    CountCellsByColor = cntRes
End Function

---

It eventually does work but it takes a considerable time for each one at least 3 minuites... So the whole thing crashes when it tries to update 40 fields with colorfunctions in

---

Looking in task manager and following the wait chain, it comes to splwow64.exe any ideas if this is the issue?

Answer 1

I'd say it's highly likely you have another event being triggered and are entering an endless or very extensive loop.

Test it by disabling the application events and see if your function runs any quicker. I've tidied up your code a little and given an example in it of how to disable the events for your testing. Of course, remember to enable the events when you're done.

Public Function ColorFunction(rColor As Range, rRange As Range, Optional isAggregating As Boolean) As Variant
    Dim rCell As Range
    Dim iRefColourIndex As Integer
    Dim result As Variant

    'Try toggling this line false and true.
    'If there's a big speed difference then you must have a _Change event causing you trouble.
    Application.EnableEvents = False

    iRefColourIndex = rColor.Interior.ColorIndex
    result = 0
    For Each rCell In rRange.Cells
        If rCell.Interior.ColorIndex = iRefColourIndex Then
            If isAggregating And IsNumeric(rCell.Value2) Then
                result = result + rCell.Value2
            Else
                result = result + 1
            End If
        End If
    Next

    ColorFunction = result

End Function