highlight cell according to date difference

[Lux Aeterna]

Hello everyone!

I' like a cell to be automatically hightlighted when the date in that cell is 15 days older than the day I type in that cell!

For example, today is October 21st, and in cell F5 I am typing the date October 1st. I'd like that cell to be highlited (I'm going to use it for the cells F5 to F10000), because the difference is more than 15 days.
(I work in a lab and it is the day of the sample receipt (column F) and the day we process the sample)

I thought of doing it using conditional formating and today function, but this means that gradually all my dates will be more than 15 days old. I saw there is an option to stop automatic calculations, but I can't use that, because the whole sheet is full of functions that I need to be updated automatically.

I also thought of adding an extra column with the day I type in the data, which would probably work just fine, but I'm trying to minimise the thingsI need to insert in the sheet.

Thank you in advance

 

[Lux Aeterna]

Thanks, it works like a charm! I also found a workaround. I allowed format to locked cells.

 

[Lux Aeterna]

Try this slight variation:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range
   
    Set rng = Intersect(Target, Range("F5:F10000"))
   
    If rng Is Nothing Then Exit Sub
   
    For Each cell In rng
        If (cell <> "") And (Date - cell > 15) Then
            cell.Interior.Color = 65535
        Else
            cell.Interior.Pattern = xlNone
        End If
    Next cell

End Sub

Hello again!

Your code has been working perfectly until today.

I am getting this message.

Any idea why?

I've mede some changes to the sheet, but non of them is related to the F column.

 

[Joe4]

What exactly is the error message you are getting?
Do you have any merged or protected cells on the sheet?

 

[Lux Aeterna]

What exactly is the error message you are getting?
Do you have any merged or protected cells on the sheet?

It seems the problem was password protection. When I locked the sheet I di not allow cell formatting. I didn't expect that to be the problem, because the specific column is not locked

 

[Joe4]

View attachment 70144

It seems the problem was password protection. When I locked the sheet I di not allow cell formatting. I didn't expect that to be the problem, because the specific column is not locked

Yes, when something works for a long time, then suddenly stops working, it is always best to consider any recent changes you made.

The easiest way to handle this (assuming you want to keep the protection) is to add a line of code unprotecting the sheet. I would do this right under this line of code:

For Each cell in rng
    Worksheets("SheetName").Unprotect "Password"

where "SheetName" is the name of the sheet and "Password" is your actual password.

Then, you can re-protect again after the last change. I would put this just above the following line of code:

    Worksheets("SheetName").Protect "Password"    
Next cell

See here for more details on protecting/unprotecting sheets via VBA code:

VBA Protect / Unprotect Worksheets - Automate Excel

In this ArticleUnprotect Excel Worksheet Without PasswordUnprotect Excel Worksheet With PasswordUnprotect Sheet – Lost PasswordProtect WorksheetsProtect Worksheet – Without PasswordProtect Worksheet – Password ProtectProtect Worksheet SettingsProtect Sheet – Allow VBA to Make ChangesUnprotect...

www.automateexcel.com

 

[Lux Aeterna]

Hey, again!

I'd like a small adjustment, if possible.

The code works perfectly fine. But if I mistype the date (e.g. if I accidentally use double slash or add extra numbers to the date) I get a debug error.

I'd like an adjustment so that the macro clears the cell if the value I enter is not in the usual format of a date.

Thank you in advance!

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range
Dim cell As Range

Set rng = Intersect(Target, Range("F5:F10033"))

If rng Is Nothing Then Exit Sub

For Each cell In rng
If (cell <> "") And (Date - cell > 30) Then
cell.Interior.Color = 65535
Else
cell.Interior.Pattern = xlNone
End If
Next cell

End Sub

 

[Joe4]

Hey, again!

I'd like a small adjustment, if possible.

The code works perfectly fine. But if I mistype the date (e.g. if I accidentally use double slash or add extra numbers to the date) I get a debug error.

I'd like an adjustment so that the macro clears the cell if the value I enter is not in the usual format of a date.

Thank you in advance!

Note the section in red that I added:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range

    Set rng = Intersect(Target, Range("F5:F10033"))

    If rng Is Nothing Then Exit Sub

    For Each cell In rng
        If (cell <> "") And Not IsNumeric(cell) Then
            Application.EnableEvents = False
            cell.ClearContents
            Application.EnableEvents = True
        End If
        If (cell <> "") And (Date - cell > 30) Then
            cell.Interior.Color = 65535
        Else
            cell.Interior.Pattern = xlNone
        End If
    Next cell

End Sub

 

[Lux Aeterna]

Note the section in red that I added:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim cell As Range

    Set rng = Intersect(Target, Range("F5:F10033"))

    If rng Is Nothing Then Exit Sub

    For Each cell In rng
        If (cell <> "") And Not IsNumeric(cell) Then
            Application.EnableEvents = False
            cell.ClearContents
            Application.EnableEvents = True
        End If
        If (cell <> "") And (Date - cell > 30) Then
            cell.Interior.Color = 65535
        Else
            cell.Interior.Pattern = xlNone
        End If
    Next cell

End Sub

Thanks a lot! I'll check it out tomorrow!

 

[Joe4]

You are welcome.

 

[Lux Aeterna]

Works perfectly!!