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.