VBA Code Creates Comments with Username and date/timestamp - Need permanent entries

[Kellie220]

** The Below code I found here, user name Hask123, not my code.** Hask123 found a similar code online and manipulated it to their needs. This seems to be what I need as well, and I need to manipulate it to my needs. I do not have a range but a coulmn I need to use it in. This would be Column A cell 2 through cell 9999 (the whole column A excluding my header). I also need what is put into the cell once it is date/user stamped to not be over road when adding a new comment to the cell. Keep the string of successive comments but make them permanent within the cell. Any suggestion on that? This is for tracking comments on each row of data. We need to track the history of what happens to the data in each row over time (Comment section). We do not want to lose visibility of the previous comments, yet we need to add new comments. Any suggestions? Is this doable?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)



Dim MyTargetRange As Range

Set MyTargetRange = ActiveSheet.Range("E17:E65")



If Not Intersect(Target, Range("E17:E65")) Is Nothing Then 'Change this range as appropriate.

If Target.Cells.Count = 1 Then

If Len(Target.Formula) > 0 Then



'If comment already exists, add a carriage return, username and timestamp to the current comment value.

If Not Target.Comment Is Nothing Then



With Target.Comment

MyString = Environ("USERNAME") & " " & Format(Now(), "ddd dd mmm yy hh:mm")

.Text Text:=Target.Comment.Text & Chr(10) & Environ("USERNAME") & " " & Format(Now(), "ddd dd-mmm-yy hh:mm")



With .Shape.TextFrame

.Characters(1, .Characters.Count).Font.Bold = False 'make the whole comment non-bold

'.Characters(InStrRev(Target.Comment.Text, Environ("USERNAME")), Len(Environ("USERNAME"))).Font.Bold = True 'Make Bold the LAST occurrence of USERNAME

.AutoSize = True

End With

End With



'If there is no comment yet, create one and add username and timestamp

Else



With Target

.AddComment

With .Comment

.Shape.AutoShapeType = msoShapeRoundedRectangle

.Text Text:=Environ("USERNAME") & " " & Format(Now(), "ddd dd-mmm-yy hh:mm")

With .Shape.TextFrame

'.Characters(1, Len(Environ("USERNAME"))).Font.Bold = True

.AutoSize = True

End With

End With

End With



End If



'Embolden each occurrence of Environ("USERNAME") in each comment in E17:E55

For Each cCom In ActiveSheet.Range("E17:E65").SpecialCells(xlCellTypeComments)

With Cells(cCom.Row, cCom.Column).Comment.Shape.TextFrame

For i = 1 To Len(cCom.Comment.Text) Step 1[/CODE]
[/CODE]

If Mid(cCom.Comment.Text, i, Len(Environ("USERNAME"))) = Environ("USERNAME") Then

.Characters(i, Len(Environ("USERNAME"))).Font.Bold = True

End If

Next i

End With

Next cCom

 

[skillilea]

Can you provide a sheet with a example comments and a few rows of data? I'd like to see what you mean by date/user stamped. Usually these are separate fields.

Thanks

 

[Kellie220]

I tried to use the excel add on, but kept telling me it would not work because of protect view. I need to dig a bit further to use the add on. BUT... here is a screen shot of the issue. Column A we put comments in every time we research the issue. Newest comment preceding older comments. I do not have an example of date/user stamp. There are some YouTube videos on it. And I did find info here as listed above. Was hoping someone could help me adjust it to my needs.

 

[skillilea]

I'm not sure what plugin you are referring to but this may work for you.

put this on your sheet code.

It assumes your column is A2 to last comment is your sheet specs.
You might want to remove the .Visible = True part. It annoyed me but, up to you.

Private Sub Worksheet_SelectionChange(ByVal target As Range)
    If target.CountLarge > 1 Then Exit Sub
    
    Dim lr As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    If Not Intersect(target, Me.Range("A1:A" & lr)) Is Nothing Then
        AppendComment target
    End If
End Sub

Private Sub AppendComment(target As Range)
    Dim comment As String, oldComment As String, userInfo As String
    
    comment = InputBox("Please enter your comment", "Add New Comment", "")
    
    ' exit if no comment given
    If Len(comment) <= 1 Then Exit Sub

    userInfo = Environ("USERNAME") & " " & Format(Now(), "ddd dd mmm yy hh:mm") & Space(5)
    
    ' if cell has existing comment
    If Not target.comment Is Nothing Then
        oldComment = target.comment.Shape.TextFrame.Characters.Text
        target.comment.Delete
    End If
    
    target.AddComment
    With target.comment.Shape
        .TextFrame.Characters.Text = userInfo & comment & Chr(10) & oldComment
        .TextFrame.AutoSize = True
        .Visible = True
    End With
End Sub

 

[Kellie220]

Hi there I really appreciate you responding to my above question. I imported your code, and nothing happens. I do not know if I am doing anything incorrectly. I added a module and pasted the code within it.

I am looking for a code that will time stamp/user stamp each entry made in column A. I am dealing with a very large data set about 16 thousand rows and about 45 columns. The only column I need this for would be column “A” but I need it for all 16 thousand rows.

I have watched a few YouTube videos, but nothing really gives me what I am looking for. Would it be easier to track the data if I insert another column let's say Column B. We would input the information in column A and then the "History" would go to column B and be stored permanently there? Just a thought. I am looking for permanent entries, time/user stamped every time someone updates Column A. We track these rows sometimes for years. It is a bit overwhelming. Thank you again for your time in helping me.

 

[skillilea]

Welcome to the board.

Open up the visual basic editor and double click on your worksheet you want to track the comments.
Paste the code directly on the worksheet module.

This event

Private Sub Worksheet_SelectionChange(ByVal target As Range)

Fires every time you move around in your sheet. If you land on column A and a valid data row an input box will pop up and you can insert your comments.

Regarding adding another field/column. That is your choice. Play with it a bit on a sample or backup copy of your sheet and see what you think.

 

[Kellie220]

That worked, Thank You. In the past with codes I always used a module. This was very helpful! I do however, get one error about protection. Part of my fields are protected. I only allow 6 columns to be open for input. The rest of the columns are the data we are researching and I do not need those to be changed. Can the code work with this?

 

[skillilea]

Try this

Put these 2 in a Module

Option Explicit

Const ProtectionPassword As String = "YourPassword"


Public Sub c(Optional wsIn As Worksheet)
' protect the sheet

    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    If Not wsIn Is Nothing Then
        Set ws = wsIn
    End If
    
    If Not ws.ProtectContents Then
        ws.Protect DrawingObjects:=True, _
            Contents:=True, _
            Scenarios:=True, _
            Password:=ProtectionPassword
            
            ws.EnableSelection = xlUnlockedCells
    End If
End Sub

Public Sub UnprotectSheet(Optional wsIn As Worksheet)
' unprotect the sheet

    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    If Not wsIn Is Nothing Then
        Set ws = wsIn
    End If
    
    ws.Unprotect Password:=ProtectionPassword
End Sub

Change this to:

Private Sub AppendComment(target As Range)
    Dim comment As String, oldComment As String, userInfo As String
    
    UnprotectSheet
    
    comment = InputBox("Please enter your comment", "Add New Comment", "")
    
    ' exit if no comment given
    If Len(comment) <= 1 Then Exit Sub

    userInfo = Environ("USERNAME") & " " & Format(Now(), "ddd dd mmm yy hh:mm") & Space(5)
    
    ' if cell has existing comment
    If Not target.comment Is Nothing Then
        oldComment = target.comment.Shape.TextFrame.characters.Text
        target.comment.Delete
    End If
    
    target.AddComment
    With target.comment.Shape
        .TextFrame.characters.Text = userInfo & comment & Chr(10) & oldComment
        .TextFrame.AutoSize = True
        .Visible = True
    End With
    
    UnprotectSheet
End Sub

 

[Kellie220]

Thank you!! It is working but not protecting the sheet back. I am testing this out in various scenarios and have come across a couple other items. I want to Thank you again for helping me. I know this takes YOUR time, and I truly appreciate it. If you can help me a bit more with a couple things I have noticed that would be awesome.

1. Your code above does not protect the sheet back. We need the protection on the multiple columns that have pre populated info from reports we run and are tracking.
2. When I click into the row in column A, it gives me the "add a comment" text box. Perfect! But what if I click the wrong row? This dialog box makes me hit cancel and will not let me click out of it. Is there a way to be able to Click out of it without hitting cancel? I mean it is OK to have the cancel there but it MAKES you hit cancel, and not just click somewhere else. and it dings and dings LOL.
3. We have notes that go back over years. I tried to copy and paste them, I was able to BUT the dialog box came up BLANK afterwards and very small. Attaching a picture. Originally I thought these "Notes" already in Column A would automatically go into the text box, but when I put my comment in, that is the only comment that comes up in the text box. So when I copied and pasted them, they are not in the text box and the text box is super tiny.
3A. in reference to the above, I did try and copy LESS text and it worked. Maybe because I was copying text that was a lot?
4. I noticed that I can CLICK in the dialog box and in the body I can delete all in there. I do not want anyone to have the ability to delete any information in the dialog box. Is there a way to protect info once entered? No changes allowed.
5. I am testing this out, but is there a limit to how many comments can be added? How many a text box can handle? I am hoping that we do not have over 100 but some of these items we track weekly, and add a comment. This could last a couple years in very rare situations. I am just checking the amount of entries and visibility we would have.

These are the items I am noticing now. I am going to keep working on it. I truly appreciate this! Thank you again.

 

[Kellie220]

Hi again I just wanted to expand on #5 there is a little to how many entries. If that could be adjusted to have unlimited entries? I am adding a screen shot of this. Also another issue.

6. When adding a comment, I would like once the comment is added to either tab out of the cell or not be able to enter into the same cell without the dialog box. I was able to enter a comment, the dialog box opened and showed my comment. Without moving out of the cell, I was able to manually enter "attempt 6" directly into cell A2, when I moved out of the cell, it stayed and then when I went back to the cell the "enter text" dialog box came up, I entered attempt 7 and when the "entries" dialog box opened, attempt 6 was not there. I am attaching a picture.

This is an amazing tool, thank you. Just making it work for us!!