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]

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

Just noticed that it won't accept dates in the format dd/mm. Is it possible to adjust it? Date formats I use are dd/mm, dd/mm/yy, dd/mm/yyyy.

Thanks again!

 

[Joe4]

Just noticed that it won't accept dates in the format dd/mm. Is it possible to adjust it? Date formats I use are dd/mm, dd/mm/yy, dd/mm/yyyy.

Thanks again!

That is all controlled in your Regional Settings. You may have to play around with those.
See here: How to change Excel date format and create custom formatting

If it doesn't recognize an entry, it will just make it text.

 

[Lux Aeterna]

That is all controlled in your Regional Settings. You may have to play around with those.
See here: How to change Excel date format and create custom formatting

If it doesn't recognize an entry, it will just make it text.

I don't know why, but not the macro just clears the cell. I tried any possible date combination (didn't change regional settings by the way). Any idea why?

 

[Joe4]

I don't know why, but not the macro just clears the cell. I tried any possible date combination (didn't change regional settings by the way). Any idea why?

At this point, your best bet would probably be to post/upload a copy of your de-sensitized (remove all sensitive data first) workbook to a file sharing site and provide a link here, so that users can download it and check it out for themselves.

 

[Lux Aeterna]

At this point, your best bet would probably be to post/upload a copy of your de-sensitized (remove all sensitive data first) workbook to a file sharing site and provide a link here, so that users can download it and check it out for themselves.

Password is 299

Please work on the List* sheets, Date column.

Thanks!

 

[Joe4]

OK, I will try to take a look at it later today when I am at my home computer and can download the file and work on it.

 

[Joe4]

OK, it took a bunch of playing around (I think because of your regional settings), but try this:

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 IsDate(cell) Then
            Application.EnableEvents = False
            cell.ClearContents
            Application.EnableEvents = True
        End If
        If (cell <> "") And (Date - CDate(cell) > 30) Then
            cell.Interior.Color = 65535
        Else
            cell.Interior.Pattern = xlNone
        End If
    Next cell

End Sub

 

[Lux Aeterna]

OK, it took a bunch of playing around (I think because of your regional settings), but try this:

It works perfectly!! Thanks

 

[Joe4]

You are welcome.
Glad I was able to help!