if fill color = this, then increment this cell by one

[forbes]

Here is my first attempt

Private Sub changeColor()
Dim x As Integer
Dim y As Integer
Dim z As Integer


Set myfrange = Sheet1.Range("AI:5").Value = x
Set myyrange = Sheet1.Range("AK:5").Value = y
Set myzrange = Sheet1.Range("AK:5").Value = z


If Range("C4:af5").Cells.Interior.Color.[Red] Then x = x + 1
If Range("C4:af5").Cells.Interior.Color.[Magenta] Then y = y + 1
If Range("C4:af5").Cells.Interior.Color.[Black] Then z = z + 1

This doesn't work. Any ideas?
Thanks

 

[Guest]

hi,
see this site for color indexes. only 7 colors have names. all the other
have index numbers.
http://www.mvps.org/dmcritchie/excel/colors.htm

i have a problem with the Range("C4:AF5").
I hope you haven't scattered these colors throught out the range and are
expecting this code to count all the colors. if so, then you will need a for
next loop to loop through the range and look at each cell color individually.
Post back with more info.

regards
FSt1

 

[Dick Kusleika]

Here is my first attempt

Private Sub changeColor()
Dim x As Integer
Dim y As Integer
Dim z As Integer


Set myfrange = Sheet1.Range("AI:5").Value = x
Set myyrange = Sheet1.Range("AK:5").Value = y
Set myzrange = Sheet1.Range("AK:5").Value = z


If Range("C4:af5").Cells.Interior.Color.[Red] Then x = x + 1
If Range("C4:af5").Cells.Interior.Color.[Magenta] Then y = y + 1
If Range("C4:af5").Cells.Interior.Color.[Black] Then z = z + 1

This doesn't work. Any ideas?
Thanks

The syntax is wrong in a few places. Try this:

Private Sub ChangeColor()

Dim MyFRange As Range, MyXRange As Range, MyYRange As Range
Dim rCell As Range

Set MyFRange = Sheet1.Range("AI5")
Set MyXRange = Sheet1.Range("AK5")
Set MyYRange = Sheet1.Range("AM5")

MyFRange.Value = 0: MyXRange.Value = 0: MyYRange.Value = 0

For Each rCell In Sheet1.Range("C4:AF5").Cells
Select Case rCell.Interior.Color
Case vbRed
MyFRange.Value = MyFRange.Value + 1
Case vbMagenta
MyXRange.Value = MyXRange.Value + 1
Case vbBlack
MyYRange.Value = MyYRange.Value + 1
End Select
Next rCell

Set MyFRange = Nothing
Set MyXRange = Nothing
Set MyYRange = Nothing
Set rCell = Nothing

End Sub

 

[forbes]

Here is my first attempt

Private Sub changeColor()
Dim x As Integer
Dim y As Integer
Dim z As Integer

Set myfrange = Sheet1.Range("AI:5").Value = x
Set myyrange = Sheet1.Range("AK:5").Value = y
Set myzrange = Sheet1.Range("AK:5").Value = z

If Range("C4:af5").Cells.Interior.Color.[Red] Then x = x + 1
If Range("C4:af5").Cells.Interior.Color.[Magenta] Then y = y + 1
If Range("C4:af5").Cells.Interior.Color.[Black] Then z = z + 1

This doesn't work. Any ideas?
Thanks

The syntax is wrong in a few places. Try this:

Private Sub ChangeColor()

Dim MyFRange As Range, MyXRange As Range, MyYRange As Range
Dim rCell As Range

Set MyFRange = Sheet1.Range("AI5")
Set MyXRange = Sheet1.Range("AK5")
Set MyYRange = Sheet1.Range("AM5")

MyFRange.Value = 0: MyXRange.Value = 0: MyYRange.Value = 0

For Each rCell In Sheet1.Range("C4:AF5").Cells
Select Case rCell.Interior.Color
Case vbRed
MyFRange.Value = MyFRange.Value + 1
Case vbMagenta
MyXRange.Value = MyXRange.Value + 1
Case vbBlack
MyYRange.Value = MyYRange.Value + 1
End Select
Next rCell

Set MyFRange = Nothing
Set MyXRange = Nothing
Set MyYRange = Nothing
Set rCell = Nothing

End Sub
--
Dick Kusleika
Microsoft MVP-Excelhttp://www.dailydoseofexcel.com- Hide quoted text -

- Show quoted text -

Thanks everyone. Dick, worked perfectly, and Fst1 thanks for the site.
I'll check it out. I don't work with VBA often, but I love the
simplicity of it when I do need it. Thanks again! Forbes