I found similar code online and modified it for my needs, but now would like to see if I can change this up so instead of putting the username, date and time in a note, it will place it in the next cell. I want it to track the historical edits not delete them. I still want the username to be bold. The only change is that instead of placing it in a comment in the cell, I want it to go in the immediate cell to the right (column F). Can anyone help me do this?
VBA 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
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
'----------------------------------------------------------------------------------------------------
End If
End If
End If
End Sub
Last edited by a moderator:
