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 If 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 If cell.Value = ColorRsnge.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.