Highlight cell when expire date is more than 40 days

Question

I am new at vba. hope you guys could help me out. I have a excelsheet which requires col J (Discharge date = DisDate) to be highlighted in red automatically when col J's date is more than 40 days as of today's date. I have been trying to figure it out but I know I am wrong somewhere. the code I have is below.

Sub highlightCell()


Dim DisDate As Range
Set DisDate = Range("J1,J3000")

For Each Cell In DisDate

If DisDate> DisDate + 40 Then
Cell.Interior.ColorIndex = 3

End If
Next
End Sub

Answer 1

Highlight by Date

• Note that BigBen has covered the two main issues (range, date) in the comments.
• Most importantly note that Ken White's proposal (in the comments) of using Conditional Formatting is practically a must: Excel will automatically highlight values that become too old tomorrow or next week when those days pass.
• For the sake of practicing VBA, study the following.

Option Explicit ' use this in each module (google it)


Sub HighlightCells()
     
    Dim dtrg As Range: Set dtrg = Range("J1:J3000") ' Date Range
    
    Dim dtCell As Range ' Date Cell
    
    For Each dtCell In dtrg.Cells
        If dtCell.Value > Date + 40 Then
            dtCell.Interior.ColorIndex = 3
        End If
    Next dtCell

End Sub


Sub HighlightCellsIssues()
     
    ' The ActiveSheet, any sheet, the selected one, the one you're looking at:
    ' could be the wrong one.
    Dim dtrg As Range: Set dtrg = Range("J1:J3000") ' Date Range
    
    ' Better
    ' By using the tab name (in 'VBE' the name in parentheses) you are
    ' specifying the exact worksheet. Someone could rename it when the code
    ' would fail.
'    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
'    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
'    Dim dtrg As Range: Set dtrg = ws.Range("J1:J3000") ' Date Range
    
    ' Best
    ' By using the code name (in 'VBE' the name not in parentheses),
    ' you are specifying the exact worksheet. It is less likely that someone
    ' would change the code name when the code would fail.
'    Dim dtrg As Range: Set dtrg = Sheet1.Range("J1:J3000") ' Date Range
    
    ' To make it dynamic, you could do:
'    Dim dtrg As Range: Set dtrg = Range("J1", Range("J" & Rows.Count).End(xlUp))
    ' or (it's the same)
'    Dim dtrg As Range: Set dtrg = Range("J1", Cells(Rows.Count, "J").End(xlUp))
    ' or (it's the same)
'    Dim dtrg As Range: Set dtrg = Range("J1", Cells(Rows.Count, 10).End(xlUp))
        
    Dim dtCell As Range ' Date Cell
    
    For Each dtCell In dtrg.Cells ' adding '.Cells' is good practice
        If dtCell.Value > Date + 40 Then ' 'TODAY()' in Excel is 'Date' in VBA
            dtCell.Interior.ColorIndex = 3 ' depends on the theme
            'dtCell.Interior.Color = vbRed ' or 255; is always red
        End If
    Next dtCell ' adding 'dtCell' is good practice

End Sub


Sub TestRange()
    If ActiveSheet Is Nothing Then Exit Sub
    If Not TypeOf ActiveSheet Is Worksheet Then Exit Sub
    
    Debug.Print "Count Cells in Range"
    Debug.Print "Wrong (only the first and last)"
    Debug.Print """J1,J3000""   " & " - " & Range("J1,J3000").Cells.Count
    Debug.Print "Correct"
    Debug.Print """J1:J3000""   " & " - " & Range("J1:J3000").Cells.Count
    Debug.Print """J1"", ""J3000""" & " - " & Range("J1", "J3000").Cells.Count
    
End Sub


Sub TestEquality()
    If 1 > 1 + 40 Then
        Debug.Print "This will never happen."
    Else
        Debug.Print "This will always happen."
    End If
End Sub