Color code cell with case statement and datestamp cell(s) to the left

Hello,

I've been wrestling with this code for quite some time which I got off of a forum that I'm trying to edit it without much luck. I have been searching this forum and others to find a solution. Currently, I'm using this code to color the cell based on a data validation list that works perfectly. I use this code so that I can copy/paste and autofill the values down, but I need a static datestamp that is inputted in the column to the left for each cell OR delete the date stamp if the cell is empty.

I've tried to add a datestamp for each case and I must not understand VBA enough because it keeps crashing my Excel when I change the data validation list. I really believe there is something very simple that I'm not getting.

Any help would be greatly appreciated

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long, i As Long
lastrow = Cells(Rows.Count, 23).End(xlUp).Row
Application.ScreenUpdating = False
For i = 11 To 500
    If Cells(i, 23).Value <> "" Then Cells(i, 23).FormatConditions.Delete
    Select Case (Cells(i, 23).Value)
    Case "Case1", "Case2":
        Cells(i, 23).Interior.ColorIndex = 37
    Case "Case3", "Case4":
        Cells(i, 23).Interior.ColorIndex = 3
'''More cases here'''
    Case Else
        Cells(i, 23).Interior.ColorIndex = xlNone
    End Select
Next i
Application.ScreenUpdating = True
End Sub

Hello garricko,

You have made a very simple mistake. You have not disabled Events. When using either the Worksheet_Change or Worksheet_SelectionChange event, you should disable events before you do anything else. If you do not, you will create a cascade event and overflow the stack. Here is the amended code.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long, i As Long
lastrow = Cells(Rows.Count, 23).End(xlUp).Row

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error GoTo  CleanExit

For i = 11 To 500
    If Cells(i, 23).Value <> "" Then Cells(i, 23).FormatConditions.Delete
    Select Case (Cells(i, 23).Value)
    Case "Case1", "Case2":
        Cells(i, 23).Interior.ColorIndex = 37
    Case "Case3", "Case4":
        Cells(i, 23).Interior.ColorIndex = 3
'''More cases here'''
    Case Else
        Cells(i, 23).Interior.ColorIndex = xlNone
    End Select
Next i

CleanExit:
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Hello garricko,

It looks like you want to change the conditional formatting of cell (if it exists) based on the contents of a cell in the range of "W11:W500" and then place a time stamp in the adjacent cell of column "U". Is that correct?

Hello garricko,

If I understand the problem correctly, this revision should do what you want.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim ClrIndex As Long
  Dim lastrow As Long, i As Long
  Dim Stamp As Variant
  
    lastrow = Cells(Rows.Count, 23).End(xlUp).Row

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error GoTo CleanExit

      For i = 11 To 500
        If Cells(i, 23).Value <> "" Then Cells(i, 23).FormatConditions.Delete
           Select Case (Cells(i, 23).Value)
             Case "Case1", "Case2":
               ClrIndex = 37: Stamp = Now()
             Case "Case3", "Case4":
               ClrIndex = 3: Stamp = Now()
           '''More cases here'''
             Case Else
               ClrIndex = xlNone: Stamp = ""
           End Select
           Cells(i, 23).Interior.ColorIndex = ClrIndex
           Cells(i, 22).Value = Stamp
        End If
      Next i

CleanExit:
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub