Hi Bro, I have a code below which can count number of cell based on cell background color even in merged cells:
Function ColorBlocks(SearchRange As range, ColorRange As range, Optional Sum As Boolean = False) As Double
Dim cell As range, blocks As range
If Sum Then
Set blocks = SearchRange(1).MergeArea(1) ' prime union method (which requires >1 value)
For Each cell In SearchRange
If cell.Interior.Color = ColorRange.Interior.Color Then Set blocks = Union(blocks, cell.MergeArea(1))
Next
If SearchRange(1).Interior.Color <> ColorRange.Interior.Color Then
ColorBlocks = WorksheetFunction.Sum(blocks) - SearchRange(1).MergeArea(1).Value
Else
ColorBlocks = WorksheetFunction.Sum(blocks)
End If
Else
Set blocks = SearchRange(1).MergeArea(1) ' prime union method (which requires >1 value)
For Each cell In SearchRange
If cell.Interior.Color = ColorRange.Interior.Color Then Set blocks = Union(blocks, cell.MergeArea(1))
Next
ColorBlocks = blocks.Count + (SearchRange(1).Interior.Color <> ColorRange.Interior.Color)
End If
End Function
then I modify the code to let it counting colored cell AND matching cell value as follows:
Function ColorBlocks(SearchRange As range, ColorRange As range, Optional Sum As Boolean = False) As Double
Dim cell As range, blocks As range
If Sum Then
Set blocks = SearchRange(1).MergeArea(1) ' prime union method (which requires >1 value)
For Each cell In SearchRange
If cell.Interior.Color = ColorRange.Interior.Color And cell.Value = ColorRange.Value Then Set blocks = Union(blocks, cell.MergeArea(1))
Next
If SearchRange(1).Interior.Color <> ColorRange.Interior.Color Then
ColorBlocks = WorksheetFunction.Sum(blocks) - SearchRange(1).MergeArea(1).Value
Else
ColorBlocks = WorksheetFunction.Sum(blocks)
End If
Else
Set blocks = SearchRange(1).MergeArea(1) ' prime union method (which requires >1 value)
For Each cell In SearchRange
If cell.Interior.Color = ColorRange.Interior.Color And cell.Value = ColorRange.Value Then Set blocks = Union(blocks, cell.MergeArea(1))
Next
ColorBlocks = blocks.Count + (SearchRange(1).Interior.Color <> ColorRange.Interior.Color)
End If
End Function
But the retured result was 1 more than actual, so please help to fix it.