Microsoft Excel - Count Merged Cell Value & Background Color

Asked By Lam Roy on 18-Jan-18 09:52 AM
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.