View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Dick Kusleika[_4_] Dick Kusleika[_4_] is offline
external usenet poster
 
Posts: 595
Default if fill color = this, then increment this cell by one

On Wed, 19 Sep 2007 13:55:09 -0700, forbes
wrote:

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-Excel
http://www.dailydoseofexcel.com