简体   繁体   中英

Change font color based on Date using VBA in Microsoft Excel

I used the code from this link to change colors of the cell if the date was less than today's date. It was working perfectly except it was changing colors for all the cells and not just the range I mentioned. The functionality I wanted to implement is real time color change of cells whenever the date is changed.

Sub SetColor()

If IsDate(ActiveCell.Value) And ActiveCell.Value < Date Then
    ActiveCell.Interior.Color = vbRed
Else
    ActiveCell.Interior.Color = RGB(217, 228, 240)
End If

End Sub

Sub ResetColor()

'Declaring variables
Dim Rng, Source As Range
Dim IntRow As Integer, IntCol As Integer

'Specifying all the cells as source range
Set Source = Range("E2:E50").SpecialCells(xlCellTypeLastCell)

'Looping through all the cells
For Each Rng In Source
    'Checking whether cell contains a value
    If Not IsEmpty(Rng) Then
        'Checking whether cell contain value of date data type
        If IsDate(Rng.Value) Then
            Rng.Select
            
            'Assigning Red color if value is less than today date
            If DateValue(Rng.Value) < Date Then
                ActiveCell.Interior.Color = vbRed
            Else
                ActiveCell.Interior.Color = RGB(217, 228, 240)
            End If
        End If
    End If
Next Rng

End Sub

    

'Insert below code in ThisWorkbook module

Option Explicit

Private Sub Workbook_Open()

With Worksheets("Main")

    'Event fired on entry to worksheet
    .OnEntry = "SetColor"
    'Event fired on sheet activation
    .OnSheetActivate = "ResetColor"
    
End With

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
With Worksheets("Main")
    .OnEntry = ""
    .OnSheetActivate = ""
End With

End Sub

You do not answer the clarification question...

Supposing that you intend to process the range "E2" up to the last cell in column "E:E" , please try replacing:

Set Source = Range("E2:E50").SpecialCells(xlCellTypeLastCell)

with:

Set Source = Range("E2:E" & Range("E" & rows.count).End(xlUp).row)

If not this is what you intend doing, I will delete my answer but please, try answering the clarification question, or try better explain what range do you wont your code to process.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM