Hi All,

I am currently counting colored cells, some are merged being counted as one.
I have 5 colors to count in 26 different ranges all on 1 sheet. Currently I
have a seperate macro to run for each seperate color in each of the 26
ranges. Each result is displayed in a MsgBox. I would like to condense
these macros to run in groups by color. For instance count all of the yellow
cells within the 26 different ranges. Then instead of a MsgBox I would like
to results on a seperate sheet somehow. This way I can preformat the results
sheet to indicate the range then the answer can go in the cell next to it.
Given a simple sample destination I can modify it to my spefic settings. I
am not fluent in macro so some guidance is appreciated.

Below are two of the macros for reference:

Option Explicit
Sub zwCoopReinYellow()
Dim c As Range
Dim MyRange As Range
Dim arrRng() As String
Dim yellowCells As Long
Dim N As Long
Dim M As Long

Set MyRange = Range("B40:E58")
ReDim arrRng(1 To MyRange.Count)

For Each c In MyRange
If c.Interior.ColorIndex = 6 Then
If c.MergeCells Then
N = N + 1
For M = 1 To N
If c.MergeArea.Address = arrRng(M) Then
Exit For
End If
Next
If M N Then
yellowCells = yellowCells + 1
arrRng(N) = c.MergeArea.Address
End If
Else
yellowCells = yellowCells + 1
End If
End If
Next
MsgBox yellowCells, vbOKOnly, "Coop Rein Yellow"
Set c = Nothing
Set MyRange = Nothing
End Sub
__________________________________________________ _______________


Option Explicit
Sub zyVisualYellow()
Dim c As Range
Dim MyRange As Range
Dim arrRng() As String
Dim yellowCells As Long
Dim N As Long
Dim M As Long

Set MyRange = Range("H32:K58")
ReDim arrRng(1 To MyRange.Count)

For Each c In MyRange
If c.Interior.ColorIndex = 6 Then
If c.MergeCells Then
N = N + 1
For M = 1 To N
If c.MergeArea.Address = arrRng(M) Then
Exit For
End If
Next
If M N Then
yellowCells = yellowCells + 1
arrRng(N) = c.MergeArea.Address
End If
Else
yellowCells = yellowCells + 1
End If
End If
Next
MsgBox yellowCells, vbOKOnly, "Visual Yellow"
Set c = Nothing
Set MyRange = Nothing
End Sub

__________________________________________________ ___________

Thanks SO much
Clint