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

 

[Joe4]

So, do you only want it to check that as you enter the value in the cell (and not done the road, for values already entered in)?
If so, you can use VBA to do that.

Righ-click on the sheet tab name (at the bottom of the screen) that you wish to apply this too, select View Code, and paste this code in the resulting VB Editor window:

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 <> "") Then
            If (Date - cell > 15) Then cell.Interior.Color = 65535
        Else
            cell.Interior.Pattern = xlNone
        End If
    Next cell

End Sub

This should do what you want automatically as you enter data into F5:F10000

 

[Lux Aeterna]

So, do you only want it to check that as you enter the value in the cell (and not done the road, for values already entered in)?
If so, you can use VBA to do that.
This should do what you want automatically as you enter data into F5:F10000

Yes, that's exactly what I need, thank you! Is it possible to reset to no highlight when I correct that cell value?

 

[Joe4]

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

 

[Lux Aeterna]

Try this slight variation

Just tried it and it works perfectly, thank you!

 

[Joe4]

You are welcome.

 

[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

I am facing a small problem. If I protect the sheet with a password, after I type something in the F column I get a debug message. Any idea what it could be and how to fix it? Thank you in advance.

 

[Joe4]

If you click "Debug", which line of code does it highlight?

 

[Lux Aeterna]

If you click "Debug", which line of code does it highlight?

This is if the cell date is > 30 days

This is if the cell date is <30 days

 

[Joe4]

OK, it sounds like the range is protected, so you are not able to make changes to it.
You will need to add lines to your code to first unprotect the sheet, then make those updates, then re-protect the sheet, i.e.

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

    ActiveSheet.Unprotect "password"
    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
    ActiveSheet.Protect "password"

End Sub

Be sure to replace "password" with your actual password.