Automatic Comment - Date Overdue

[Mr Nolen]

Hello good people of MrExcel,

I need a way for Excel to automatically create a comment "Comment Generated on (Today's date)" in a specific field, let's say "Q9", when the date in field "U9" is -180 days or more from today's date or rather when 180 days or more have passed. I have been searching google and these forums, and I've found something similar, but not quite what I needed. Any help is appreciated!

​

 

[Youngdand]

HI,

At what point would you want to apply the comments? on cell change? on sheet open? on sheet close? Press a button?

Cheers,

Dan.

 

[Mr Nolen]

HI,

At what point would you want to apply the comments? on cell change? on sheet open? on sheet close? Press a button?

Cheers,

Dan.

Dan,

Thank you for the response. On cell change, preferably. Though, I only need it to create a comment once. Then, we can manually change it later.

 

[Youngdand]

Also, When you say comment, do you mean an actual excel comment, or just to enter that text in to the field q9?

the below will loop through all dates in column q and apply a comment to q where the date exceeds 180 days.

Sub commentoverdue()
Dim a As Range
Dim LR As Long
Set a = Range("q1")
LR = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To LR
If DateDiff("d", a, Date) > 180 Then
With ActiveSheet.Range("q1").AddComment
 .Visible = False
 .Text "reviewed on " & Date
End With
End If
Next i
End Sub

 

[Youngdand]

You can apply the above to a button should you wish, or add it to your ribbon.

 

[Mr Nolen]

You can apply the above to a button should you wish, or add it to your ribbon.

Dan,

Sorry for late response, I've been trying to get this to work, without success. If I do it exactly as listed above, I get an error "Application-defined or object-defined error" on line "With ActiveSheet.Range("q1").AddComment". So, I made a simplified version and I can get it to work for one cell, Q1, but it doesn't not go any further without returning an error "type mismatch" on "If DateDiff("d", a, Date) > 180 Then". I have been unsuccessful in applying the above code to the entire column.

 

[Youngdand]

Sorry My Mistake,

Sub commentoverdue()
Dim a As Range
Dim LR As Long
Set a = Range("q1")
LR = Cells(Rows.Count, 17).End(xlUp).Row
For i = 1 To LR
If DateDiff("d", Range("q" & i), Date) > 180 Then
With ActiveSheet.Range("q" & i).AddComment
 .Visible = False
 .Text "reviewed on " & Date
End With
End If
Next i
End Sub

It seems to error when there are comments already in the field.
will your data have previous comments? do they need to be skipped if they do?

 

[Youngdand]

This version will remove any comments currently in the cells and will replaced with a new comment if this suits your purpose.

Sub commentoverdue()
Dim a As Range
Dim LR As Long
Set a = Range("q1")
LR = Cells(Rows.Count, 17).End(xlUp).Row
For i = 1 To LR
If DateDiff("d", Range("q" & i), Date) > 180 Then
ActiveSheet.Range("q" & i).Comment.Delete
With ActiveSheet.Range("q" & i).AddComment
 .Visible = False
 .Text "reviewed on " & Date
End With
End If
Next i
End Sub

 

[Mr Nolen]

Sorry My Mistake,

Sub commentoverdue()
Dim a As Range
Dim LR As Long
Set a = Range("q1")
LR = Cells(Rows.Count, 17).End(xlUp).Row
For i = 1 To LR
If DateDiff("d", Range("q" & i), Date) > 180 Then
With ActiveSheet.Range("q" & i).AddComment
 .Visible = False
 .Text "reviewed on " & Date
End With
End If
Next i
End Sub

It seems to error when there are comments already in the field.
will your data have previous comments? do they need to be skipped if they do?

Yes, basically, I want to be able to press the button any time and have it recalculate the dates, without removing the previous comments.

 

[Youngdand]

OK this should do it.

The Below strips all previous comments, and writes new comments against overdue items. It ignores blank cells and moves to the next cell.

re reading you first post your dates are in column u, so change instances of q to u, and 17 to 21 if these are the field you use.

Sub commentoverdue()
Dim a As Range
Dim LR As Long
Set a = Range("q1")
LR = Cells(Rows.Count, 17).End(xlUp).Row
ActiveSheet.Cells.ClearComments
For i = 1 To LR
'If ActiveSheet.Range("q" & i) <> "" Then
If DateDiff("d", Range("q" & i), Date) > 180 And ActiveSheet.Range("q" & i) <> "" Then
With ActiveSheet.Range("q" & i).AddComment
 .Visible = False
 .Text "reviewed on " & Date
End With
End If
Next i
End Sub

Let me know if this does it for you.

Cheers.

Dan.