PDA

View Full Version : count matching cell colors



runball
09-18-2009, 09:23 AM
hi guys,

so ive asked this question on a few forums and got 0 response, i'm running a football, so every one has there own sheet with all the weeks on it and i email it to them, all they have to do is click on the teams they think will win and it turns yellow and email it back.... so i got all that working, now what i want is, i have the winning teams on the final score sheet.. so ill use debbie as an example, so if you click debbie you will see her selections for week 1 and if they match i want it to put a 1 on the pool standing sheet under week 1? insted of me doing it by putting a 1 beside the ones she got right.... i hope you understand what i mean? (excel 2007)

Dr.K
09-18-2009, 12:12 PM
You need to compare two Ranges, Cell by Cell. You'll need two Integer variables: one to track what position in the ranges you are currently comparing, and one to track how many they got right. The property that you are looking for is called .Interior.ColorIndex

Here is an example of iterating through a range of cells. This Function counts the number of cells of a specifc color in a given Range, so it won't do exactly what you need... but this will show you how to use the ColorIndex property.

Function CountColoredCells(InputRange As Range, ColorIndexNumber As Integer) As Long

Dim rngCell As Range
For Each rngCell In InputRange

If rngCell.Interior.ColorIndex = ColorIndexNumber Then
CountColoredCells = CountColoredCells + 1
End If

Next rngCell

End Function

mdmackillop
09-19-2009, 04:31 AM
Something like this. WEEK1 is entered in Pool Standing D30
However....
Your Name sheets do not have the same layout as your Final Scores Sheets,
Week numbers are not in consistent locations, Hidden rows change relevant positions. It is not insoluble, just much more coomplicated with inconsistencies.


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim cel As Range
If Sh.Index > 3 Then
Sh.Unprotect
Set c = Sh.Cells.Find(Sheets("Pool Standing").Range("B30")).Offset(2).Resize(17)
For Each cel In c
cel.Offset(, 3) = 0
If cel.Interior.ColorIndex = 6 And _
Sheets("Final Scores").Range(cel.Offset(, 1).Address).Interior.ColorIndex = 6 Then
cel.Offset(, 3) = 1
End If
Next
Set c = Sh.Cells.Find(Sheets("Pool Standing").Range("B30")).Offset(2, 2).Resize(17)
For Each cel In c
If cel.Interior.ColorIndex = 6 And _
Sheets("Final Scores").Range(cel.Offset(, 1).Address).Interior.ColorIndex = 6 Then
cel.Offset(, 1) = 1
End If
Next
End If
Sh.Protect
End Sub

runball
09-19-2009, 05:05 PM
did you get it to work?

runball
09-23-2009, 07:03 PM
maybe im in over my head!!??

mdmackillop
09-24-2009, 01:18 AM
It is working for Week 1.
In order to keep the code simple, you need to adjust your page layouts to make them identical, and the Score blocks also.
On the Name Sheets, Week 1 in in column B, Week 2 in column H ie different relative to the team columns
Row 5 is hidden in the top set of scores; no hidden rows below.
Team names are in Cols B,G,L and in Final Score C,I,O

If you make layouts regular and consistent, a solution is quite simple, but not as it is now.

runball
09-24-2009, 11:45 AM
ok i make a new sheet called "winners" and its the same as all the user sheets, i still have 3 hidden rows... E-J-O.... if i delete them, then i would have to re-do my first marco, so if you look at the winners sheet and don... they are the same now, but i guess the code has to chage a bit right?