根据日期和其他条件突出显示单元格

Question

I am trying to code in VBA a highlighting function based on certain conditions. I can easily do this via conditional formatting, but I have noticed that if a user cuts/pastes (other than special)/deletes rows/etc. then the conditional formatting ranges are modified. I want the conditional formatting ranges to stay fixed rather than mapped to the actual cells. If anyone knows how to do that, or protect the conditional formatting but still allow data manipulation, then this code would be unnecessary.

I have found two different codes that I have been trying but since I'm new to VBA, I'm not very good at it and run into problems. I don't know how to use the Isblank or Isempty feature for one.

I need to highlight dates that are earlier than 30 days from now (including dates passed) in red. I need to highlight dates that are earlier than 60 days from now but more than 30 in yellow. Cells without data and cells beyond 60 days out must remain unhighlighted.

Any help is greatly appreciated!

Private Sub Worksheet_Change(ByVal Target As Range)

Dim icolor As Integer

    If Not Intersect(Target, Range("C3:T65")) Is Nothing Then

        Select Case Target

            Case Is <= Date + 60

                icolor = 6

            Case Is <= Date + 30

                icolor = 3

            Case IsEmpty()

                icolor = 2

        End Select


        Target.Interior.ColorIndex = icolor

    End If

End Sub

Other option:

Sub Highlight()
    Dim cell As Range

    For Each cell In Range("C3:T65")
        If cell.Value <= Date + 60 And cell.Value > Date + 30 Then
            cell.Offset(0, 1).Interior.ColorIndex = 6

        ElseIf cell.Value <= Date + 30 Then
            cell.Offset(0, 1).Interior.ColorIndex = 3

        ElseIf cell.Value IsEmpty() Then
            cell.Offset(0, 1).Interior.ColorIndex = 2

        End If
    Next cell

End Sub

Answer 1

使用VBNullString检查单元格为空：

ElseIf cell.Value = vbNullString Then

Answer 2

Both your codes are almost there. The following combination of the two should do the job:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim icolor As Integer
    Dim cell As Range

    If Intersect(Target, Range("C3:T65")) Is Nothing Then Exit Sub

    For Each cell In Target
        icolor = 0
        Select Case cell
            Case Is <= Date + 30: icolor = 3
            Case Is <= Date + 60: icolor = 6
            Case "": icolor = 2
        End Select
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor
    Next cell
End Sub