VBA - Count cells by color

[sofiachr]

Hi!

I have the below VBA code and use the formula =CountCellsByColor($A$2:$A$9;D1) where I want to sum my colors. A2:A9 is where my list is in my test document and D1 being my referens for what color to look for. Problem is I get the right count first time but when I change one cells color in the range A2:A9 the sum doesn´t change. If I however copy another cell with the color I want and paste in the cell I´m changing then the sum will change. I don´t know how to fix this. Not everyone using the file knows this is required, they need to be able to just format the cell as normal and the sum must follow.

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 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

 

[Fluff]

You could put this in the relevant sheet module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

although all formulae on that sheet will recalculate whenever you select a different cell.
Also once you have changed the colour of D1 you will need to select another cell.

 

[sofiachr]

You could put this in the relevant sheet module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

although all formulae on that sheet will recalculate whenever you select a different cell.
Also once you have changed the colour of D1 you will need to select another cell.

Hi, no change unfortunately.
/Sofia

 

[sofiachr]

You could put this in the relevant sheet module

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

although all formulae on that sheet will recalculate whenever you select a different cell.
Also once you have changed the colour of D1 you will need to select another cell.

Sorry, to fast. It work perfect, thank you!

 

[Fluff]

You're welcome & thanks for the feedback.