Counting code VBA - my code is lagging please help

[Patriot2879]

Hi good morning, i have the code below for counting colours, but when i press F9 to update it lags and takes a while to update and i cant do anything else in Excel until this has updated. I hope you can help me please.

Function GetCellColor(xlRange As Range)
    Dim indRow, indColumn As Long
    Dim arResults()

    Application.Volatile

    If xlRange Is Nothing Then
        Set xlRange = Application.ThisCell
    End If

    If xlRange.Count > 1 Then
      ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
       For indRow = 1 To xlRange.Rows.Count
         For indColumn = 1 To xlRange.Columns.Count
           arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
         Next
       Next
     GetCellColor = arResults
    Else
     GetCellColor = xlRange.Interior.Color
    End If
End Function

Function GetCellFontColor(xlRange As Range)
    Dim indRow, indColumn As Long
    Dim arResults()

    Application.Volatile

    If xlRange Is Nothing Then
        Set xlRange = Application.ThisCell
    End If

    If xlRange.Count > 1 Then
      ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
       For indRow = 1 To xlRange.Rows.Count
         For indColumn = 1 To xlRange.Columns.Count
           arResults(indRow, indColumn) = xlRange(indRow, indColumn).Font.Color
         Next
       Next
     GetCellFontColor = arResults
    Else
     GetCellFontColor = xlRange.Font.Color
    End If

End Function

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

Function SumCellsByColor(rData As Range, cellRefColor As Range)
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim sumRes

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

    SumCellsByColor = sumRes
End Function

Function CountCellsByFontColor(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).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            cntRes = cntRes + 1
        End If
    Next cellCurrent

    CountCellsByFontColor = cntRes
End Function

Function SumCellsByFontColor(rData As Range, cellRefColor As Range)
    Dim indRefColor As Long
    Dim cellCurrent As Range
    Dim sumRes

    Application.Volatile
    sumRes = 0
    indRefColor = cellRefColor.Cells(1, 1).Font.Color
    For Each cellCurrent In rData
        If indRefColor = cellCurrent.Font.Color Then
            sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
        End If
    Next cellCurrent

    SumCellsByFontColor = sumRes
End Function

Then i have this code in the cell =CountCellsByColor(Sheet2!A:A,Sheet1!F3)

 

[Patriot2879]

HI i have just added a new code and put in a module but F9 doesnt work on it to refresh

Function Color_Cell_Count(ColorCell As Range, DataRange As Range)

Dim Data_Range As Range
Dim Cell_Color As Long

Cell_Color = ColorCell.Interior.ColorIndex

For Each Data_Range In DataRange

If Data_Range.Interior.ColorIndex = Cell_Color Then
Color_Cell_Count = Color_Cell_Count + 1
End If

Next Data_Range

End Function

Then i put this in the cell =Color_Cell_Count(A1, Sheet2!A:A)