Changing color of a cell based on each change in cell value (not a conditional format)

[sanilmathews]

Hi All,

I would need a code for the below requirement on Worksheet_Change with each change in an ActiveCell.

A random cell (say A2) would be blank and also interior color as "No fill" initially. When there is first data input in cell A2, the cell color would change to yellow. For each instance of input the color would change for the cell A2. With this I could identify on how many instances of input was done on the same cell (i.e. A2) by a user using color code.

Initial = No fill
First input = Green
Second Input = Yellow
Third Input = Orange
Fourth Input and beyond = Red

I have the below code which is actually not giving what is expected. However I would appreciate if I can get a code that actually meets the above requirement.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Interior.ColorIndex = -4142 Then ActiveCell.Interior.ColorIndex = 43
If ActiveCell.Interior.ColorIndex = 43 Then ActiveCell.Interior.ColorIndex = 6
If ActiveCell.Interior.ColorIndex = 6 Then ActiveCell.Interior.ColorIndex = 44
If ActiveCell.Interior.ColorIndex = 44 Then ActiveCell.Interior.ColorIndex = 22
End Sub

 

[Fluff]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
      With Target.Interior
         Select Case .ColorIndex
            Case -4142: .ColorIndex = 43
            Case 43: .ColorIndex = 6
            Case 6: .ColorIndex = 44
            Case Else: .ColorIndex = 22
         End Select
      End With
   End If
End Sub

this works on A2:A100, but you can change the range to suit

 

[sanilmathews]

How about

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("A2:A100")) Is Nothing Then
      With Target.Interior
         Select Case .ColorIndex
            Case -4142: .ColorIndex = 43
            Case 43: .ColorIndex = 6
            Case 6: .ColorIndex = 44
            Case Else: .ColorIndex = 22
         End Select
      End With
   End If
End Sub

this works on A2:A100, but you can change the range to

Thank you for your response. I actually not needed to define any range. It should be executing on any given ActiveCell.

 

[Fluff]

And?

 

[Joe4]

Thank you for your response. I actually not needed to define any range. It should be executing on any given ActiveCell.

Then just remove the range "IF" clause from Fluff's code, i.e.

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub

         With Target.Interior
         Select Case .ColorIndex
            Case -4142: .ColorIndex = 43
            Case 43: .ColorIndex = 6
            Case 6: .ColorIndex = 44
            Case Else: .ColorIndex = 22
         End Select
      End With

End Sub