Cell color changes based on conditions in Excel VBA-CodePudding

I have a requirement to have a tracker in Excel in which color changes based on Condition. Cell D has Due Date & E:H also has date. When the E:H columns date changes the color also changes based on conditions. Please Help. Thanks

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
    On Error Resume Next
    If Target.Value = "" Then
        Target.Offset(0, 1) = ""
     Else
        'Dim oldVal As Date
        Set oldVal = Oval
        'MsgBox oldVal
         Target.Offset(0, 1).Value = Date
         Target.Offset(0, 2).Value = Date
         Target.Offset(0, 3).Value = Date
         Target.Offset(0, 4).Value = Date
    End If
End If
Call ColorMeElmo
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D:D")) Is Nothing Then
    On Error Resume Next
    If Target.Value = "" Then
        Target.Offset(0, 1) = ""
     Else
        'Dim oldVal As Date
        Set oldVal = Oval
        'MsgBox oldVal
         Target.Offset(0, 1).Value = Date
         Target.Offset(0, 2).Value = Date
         Target.Offset(0, 3).Value = Date
         Target.Offset(0, 4).Value = Date
    End If
End If
Call ColorMeElmo
End Sub


Sub ColorMeElmo()
   MsgBox "Called Coror"
   Dim i As Long, r1 As Range, r2 As Range

   For i = 2 To 5
      Set r1 = Range("D" & i)
      Set r2 = Range("E" & i & ":H" & i)
     
      Dim diff As Long
      diff = DateDiff("D", r1.Value, r2.Value)
      
      If diff > 10 Then r2.Interior.Color = vbRed
      If diff < 11 Then r2.Interior.Color = vbYellow
      
Next i
End Sub

CodePudding user response：

DateDiff formula need two date values, but r2.value is not a valid date. change:

Set r2 = Range("E" & i & ":H" & i)

to:

Set r2 = Range("E" & i)