Problem with VBA - function needs to be constantly refreshed for proper values

[MZ1]

Dear all,
I have an issue with the code below.

    Function CountColor(CellsRange As Range, ReferenceCell As Range) As Integer
       Dim indRefColor As Long
       Dim Format As Range
       Dim CountColor2 As Integer
       
       Application.Volatile
       CountColor = 0
       indRefColor = Evaluate("cfcolour(" & ReferenceCell.Address & ")")
       For Each cell In CellsRange
          If Evaluate("CFColour(" & cell.Address & ")") = indRefColor Then
             CountColor = CountColor + 1
          End If
       Next
    End Function

    Function CFColour(Cl As Range) As Double
       CFColour = Cl.DisplayFormat.Interior.Color
    End Function

The main idea behind this code is to calculate the number of cells which have the same background colour as the particular cell.
the code is working, but when you change the sheet you have to manually refresh it to have proper values.

Even if you save an excel file and get to a different sheet you get bad values. It will be very helpful if someone can tell me how to refresh this code when the excel sheet is changed or how to change the code so changes in one sheet didn't affect values on the other sheets.

Many thanks for your help.

 

[offthelip]

The probelm is that changing the formatting doesn't triggerthe worksheet change event and so doesn't trigger a recalculation. You can force a recalcualtion by putting this code in the workbook workhseet selection change which means it will update as soon as you select another cell.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Calculate
End Sub

 

[MZ1]

Thank you very much. Your solution works!!!