Increment Number in a column every time a cell changes color

[naylorpsu]

If I have a column where some cells are blue and some are white, I want to start at 1 and increment by 1 only when the color changes in the cell below it. If a cell changes colors again, I would like to increment by 1 again all the way to the bottom of the column.

Could someone point me in the right direction?

Thank you in advance and have a great evening,
Bob

 

[Rick Rothstein]

If I have a column where some cells are blue and some are white, I want to start at 1 and increment by 1 only when the color changes in the cell below it. If a cell changes colors again, I would like to increment by 1 again all the way to the bottom of the column.

You were a little skimpy on details, so I guessed your column was Column D and that you wanted the count presented to you in a MessageBox...

[table="width: 500"]
[tr]
	[td]Sub CountCellColorChanges()
  Dim R As Long, Cnt As Long, Col As Range
  Set Col = Columns("D")
  For R = 1 To ActiveSheet.UsedRange.Rows.Count
    If Cells(R, Col.Column).DisplayFormat.Interior.Color <> Cells(R + 1, Col.Column).DisplayFormat.Interior.Color Then Cnt = Cnt + 1
  Next
  MsgBox Cnt
End Sub[/td]
[/tr]
[/table]

 

[naylorpsu]

Sorry about the lack of detail. So it can be any column...Column D will work. The Column D does not contain any data, just the cell color. I would like the value to be displayed in the cell.

So picture the following:

Cells D1 through D3 cell color are white
Cell D4 through D5 are blue
Cell D6 is white

D1 through D3 would contain 1. Values in D1 through D3 would be 1.
Then the color change to blue on D4 would increment to 2. Values in D4 and D5 would be 2.
Then the color change to white on D6 would increment to 3

Thank you again for your help,
Bob

 

[naylorpsu]

I was able to tweak the code (hopefully it makes sense) and here is what I was able to make work:

Sub CountCellColorChanges()
Dim R As Long, Cnt As Long, Col As Range, ID As Long
Set Col = Columns("A")
ID = 0
For R = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(R, Col.Column).DisplayFormat.Interior.Color <> Cells(R - 1, Col.Column).DisplayFormat.Interior.Color _
Then ID = ID + 1


Cells(R, Col.Column).Value = ID
Next
End Sub

Thank you for all your help in pointing me in the right direction. I really appreciate you trying to decipher what little information I provided.

Have a great day,
Bob