Count Highlighted numbers in an area

[basic]

I have a tough and unusual question that I'm not sure can be done.

I have a spreadsheet that has different cells highlighted in two different
colors. I am trying to add up the number of times a highlighted number (of
the two colors) appear in a section.

I am trying to search A1..AS2 , A4..E26, F4..O8.
The two colors to look for are:
Color index= 39 or 4
Pattern= xlsolid

I am looking for a total of highlighted numbers that include both colors.
The numbers I would be searching for are from 1-9 and I would like to find
out how many 1's, 2's, 3's...etc.

Example:

#1= 4 times
#2= 6 times
#3= 0 times
#4= 2 times

 

[JLatham]

Hopefully this macro will do the job for you. Just have the sheet with those
ranges you need to check selected when you use Tools | Macro | Macros to run
it.

To put it into your workbook, open the workbook and press [Alt]+[F11] to
enter the VB Editor. Choose Insert | Module and then copy the code below and
paste it into the empty module presented to you.

Sub CountByColors()

Dim valueCounts(1 To 9) As Integer
Dim seekRange As Range
Dim anySeekEntry As Range
Dim resultsMessage As String
Dim LC As Integer
Const ci39 = 39
Const ci4 = 4

'assumes sheet in question is active sheet
Set seekRange = Range("A1:AS2")
For Each anySeekEntry In seekRange
If anySeekEntry.Interior.ColorIndex = ci4 Or _
anySeekEntry.Interior.ColorIndex = ci39 Then
If anySeekEntry >= 1 And anySeekEntry <= 9 Then
valueCounts(anySeekEntry.Value) = valueCounts(anySeekEntry.Value) + 1
End If
End If
Next
Set seekRange = Range("A4:E26")
For Each anySeekEntry In seekRange
If anySeekEntry.Interior.ColorIndex = ci4 Or _
anySeekEntry.Interior.ColorIndex = ci39 Then
If anySeekEntry >= 1 And anySeekEntry <= 9 Then
valueCounts(anySeekEntry.Value) = valueCounts(anySeekEntry.Value) + 1
End If
End If
Next
Set seekRange = Range("F4:O8")
For Each anySeekEntry In seekRange
If anySeekEntry.Interior.ColorIndex = ci4 Or _
anySeekEntry.Interior.ColorIndex = ci39 Then
If anySeekEntry >= 1 And anySeekEntry <= 9 Then
valueCounts(anySeekEntry.Value) = valueCounts(anySeekEntry.Value) + 1
End If
End If
Next
resultsMessage = "Results: " & vbCrLf
For LC = LBound(valueCounts) To UBound(valueCounts)
resultsMessage = resultsMessage & "#" & LC & " = " & _
valueCounts(LC) & vbCrLf
Next
MsgBox resultsMessage, vbOKOnly, "Your Results"
Set seekRange = Nothing ' housecleaning
End Sub

 

[basic]

Thanks J,

Very Impressive! This is exactly what I what I am looking 4. The only
problem is I told you I was looking for highlighted font. I should have said
highlighted fill.
The background is highlighted in these colors not the actual font. Is there
anyway to have it look for the fill not the font.

Thanks again,

Tom

Hopefully this macro will do the job for you. Just have the sheet with those
ranges you need to check selected when you use Tools | Macro | Macros to run
it.

To put it into your workbook, open the workbook and press [Alt]+[F11] to
enter the VB Editor. Choose Insert | Module and then copy the code below and
paste it into the empty module presented to you.

Sub CountByColors()

Dim valueCounts(1 To 9) As Integer
Dim seekRange As Range
Dim anySeekEntry As Range
Dim resultsMessage As String
Dim LC As Integer
Const ci39 = 39
Const ci4 = 4

'assumes sheet in question is active sheet
Set seekRange = Range("A1:AS2")
For Each anySeekEntry In seekRange
If anySeekEntry.Interior.ColorIndex = ci4 Or _
anySeekEntry.Interior.ColorIndex = ci39 Then
If anySeekEntry >= 1 And anySeekEntry <= 9 Then
valueCounts(anySeekEntry.Value) = valueCounts(anySeekEntry.Value) + 1
End If
End If
Next
Set seekRange = Range("A4:E26")
For Each anySeekEntry In seekRange
If anySeekEntry.Interior.ColorIndex = ci4 Or _
anySeekEntry.Interior.ColorIndex = ci39 Then
If anySeekEntry >= 1 And anySeekEntry <= 9 Then
valueCounts(anySeekEntry.Value) = valueCounts(anySeekEntry.Value) + 1
End If
End If
Next
Set seekRange = Range("F4:O8")
For Each anySeekEntry In seekRange
If anySeekEntry.Interior.ColorIndex = ci4 Or _
anySeekEntry.Interior.ColorIndex = ci39 Then
If anySeekEntry >= 1 And anySeekEntry <= 9 Then
valueCounts(anySeekEntry.Value) = valueCounts(anySeekEntry.Value) + 1
End If
End If
Next
resultsMessage = "Results: " & vbCrLf
For LC = LBound(valueCounts) To UBound(valueCounts)
resultsMessage = resultsMessage & "#" & LC & " = " & _
valueCounts(LC) & vbCrLf
Next
MsgBox resultsMessage, vbOKOnly, "Your Results"
Set seekRange = Nothing ' housecleaning
End Sub

I have a tough and unusual question that I'm not sure can be done.

I have a spreadsheet that has different cells highlighted in two different
colors. I am trying to add up the number of times a highlighted number (of
the two colors) appear in a section.

I am trying to search A1..AS2 , A4..E26, F4..O8.
The two colors to look for are:
Color index= 39 or 4
Pattern= xlsolid

I am looking for a total of highlighted numbers that include both colors.
The numbers I would be searching for are from 1-9 and I would like to find
out how many 1's, 2's, 3's...etc.

Example:

#1= 4 times
#2= 6 times
#3= 0 times
#4= 2 times