Cell Modified date and other addidtions

[JamesPTuttle]

I spent the last few days browsing through your codes. Great resource - THANKS

I have (columns) cells A ~ G with info and I update cells H ~ K

I need to track when changes are made an insert the date, time and
user name into a cell comment associated with the changed cell (H ~ K)

I also want to H ~ K to turn the cell text red after 90 days if not changed

Icing on the cake would be to allow the "date, time, username"
comment to append the cell comment instead of outright replacing it -
if the comment already exist/ or create a new one

Below are some codes taken from various archives, any in their own way, each works separately, but not together

Insert comment with now and user name below

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'will put date in a comment when something is put in Column A created by Paul B
If Target.Column = 1 Then
Comment = ("Cell Last Edited: ") & Now & (" by ") & Application.UserName
Target.Cells.NoteText Comment
End If
End Sub

Turn Cell red (I would like cell text red) below

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim comment As String
With Target
If .Column = 1 Then
comment = ("Cell Last Edited: ") & Format(Date, "mm/dd/yy") & (" by ") & Application.UserName
.Cells.NoteText comment
.Interior.ColorIndex = xlNone
End If
End With
End Sub

Private Sub Workbook_Open()
Dim rng As Range, cell As Range, dte As Date
Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'Change as required
Application.ScreenUpdating = False
ws.Activate
Set rng = Intersect([A:A], ActiveSheet.UsedRange)
For Each cell In rng
On Error GoTo e
If Not cell.comment Is Nothing Then
dte = Mid(cell.NoteText, 19, 8)
If Date >= dte + 30 Then cell.Interior.ColorIndex = 3
End If
e: On Error GoTo 0
Next
End Sub


THANKS for any help

James

 

[JamesPTuttle]

Hello Erik,

I have been busy putting the code into action and seeing how it works.
Below is everything that I have at the moment. The "insert comment on modification" works well - almost too well. It inserts a comment on any cell that is modified.

The other code to turn the cell text red based upon "date + 30 days" works perfectly. It only affects (as far as I can see) the cells in the range.

If I could, one last request for assistance and I will be out of your hair.

Can you help with the "insert comment" code.
Can you insert code so that it ONLY "looks at" and inserts comments on range F to H, and cells J, and T. If that is too hard, I can get away with just cells F, J and T

THANK YOU VERY MUCH

James

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ccc As Range
Dim comment As String
comment = ("Cell Last Edited: ") & Now & (" by ") & Application.UserName
Target.Cells.NoteText comment
End Sub

Sub Test()

Dim rng As Range, cell As Range, dte As Date
Dim ws As Worksheet
Dim datetest As Date

Set ws = Worksheets("Sheet1") 'Change as required
Application.ScreenUpdating = False
ws.Activate
Set rng = Intersect([F:J], ActiveSheet.UsedRange)

For Each cell In rng
On Error GoTo e
If Not cell.comment Is Nothing Then
dte = Mid(cell.NoteText, 19, 8)
datetest = dte + 30
If Date >= dte + 30 Then cell.Font.ColorIndex = 3
End If

e: On Error GoTo 0
Next

End Sub

 

[erik.van.geit]

James,

You're really welcome with all your questions, you really don't sit in my hair. I'm learning as well as you. So please if you have further questions, go on.

What do you mean by (in bold):
"
Can you insert code so that it ONLY "looks at" and inserts comments on range F to H, and cells J, and T. If that is too hard, I can get away with just cells F, J and T
"
columns F, H, J, T ?

regards,
Erik

 

[JamesPTuttle]

Erik,

Currently, any cell that I modify within the worksheet, upon finishing, the "Private Sub Worksheet_Change" macro inserts a comment with the date", "time" and my "user name"
(see first set of code from previous email)

What I would prefer is for the "comment" to ONLY be inserted on cells in columns F, H, J & T.

Note: I only modify one cell at a time

Thanks

James

 

[erik.van.geit]

James,

remember the code that you sent yourself at the beginning of this thread:
If Target.Column = 1 Then

That's just what you need.
It says: "If the columnnumber of the cell you just modified is 1" then ...
So change this to

If Target.Column = 6 OR If Target.Column = 8 OR If Target.Column = 10 OR If Target.Column = 20 Then

add an End If further on

the result is

Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
Dim ccc As Range 
Dim comment As String 
If Target.Column = 6 OR If Target.Column = 8 OR If Target.Column = 10 OR If Target.Column = 20 Then
comment = ("Cell Last Edited: ") & Now & (" by ") & Application.UserName 
Target.Cells.NoteText comment 
End If
End Sub

I'm sure you begin to understand the rules of the game !
Perhaps somebody can shorten the "If-part" ?

regard,
Erik

 

[JamesPTuttle]

Hello Erik,

Thanks for the advice. I inserted your code and had to play with it for a bit because there were compile errors. It WORKS as wanted now.

I attached the final code below for you (and others to see)

This being my first foray into VB has been positive and successful

THANKS again

James


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ccc As Range
Dim comment As String
If Target.Column = 6 Or Target.Column = 8 Or Target.Column = 10 Or Target.Column = 20 Then
comment = ("Cell Last Edited: ") & Now & (" by ") & Application.UserName
Target.Cells.NoteText comment
End If

e: On Error GoTo 0

End Sub

Sub Test()

Dim rng As Range, cell As Range, dte As Date
Dim ws As Worksheet
Dim datetest As Date

Set ws = Worksheets("Sheet1") 'Change as required
Application.ScreenUpdating = False
ws.Activate
Set rng = Intersect([F:J], ActiveSheet.UsedRange)

For Each cell In rng
On Error GoTo e
If Not cell.comment Is Nothing Then
dte = Mid(cell.NoteText, 19, 8)
datetest = dte + 30
If Date >= dte + 30 Then cell.Font.ColorIndex = 3
End If

e: On Error GoTo 0
Next

End Sub

 

[erik.van.geit]

Thanks,
this line isn't necessary anymore

Dim ccc As Range

it belongs to the previous version

You probably have a reason to add the error traps, but I'm not fresh anymore to see them.
Succes with your further adventures in the land of VBA !

Erik