user2836976 February 2016

Excel automatically add comment with cell edit history

I have the following code in the "sheet macros" (right click sheet - view code). It used to work but now it's not adding comments in my specified range A5:AQ155.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'If (Target.Row > 3 And Target.Row < 155) Then Cells(Target.Row, "AT") = Now()

Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long
Dim bHasComment As Boolean


With Target(1)
If Intersect(.Cells, Range(sRng)) Is Nothing Then Exit Sub
sNew = .Text
sOld = .Text
.Value = sNew
Application.EnableEvents = True


sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld


If Target(1).Comment Is Nothing Then
.AddComment
Else
iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
End If


With .Comment.Shape.TextFrame
.AutoSize = True
.Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
End With
End With
End Sub

What have I done wrong?

Answers


Scott Holtzman February 2016

The code stopped firing because Event Firing was disabled and never turned back on. The way the code is written, as soon as someone makes a change to the worksheet outside the range A5:AQ155, the Events become disabled without being turned back on, which means subsequent event triggers will not be fired (ie. - the next time you edit a cell).

If you make these slight tweaks in the code it should work as intended going forward.

However, before you do this type Application.EnableEvents = True in the immediate window and hit Enter to turn events back on so that the code begins to fire again.

Private Sub Worksheet_Change(ByVal Target As Range)

Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long

If Not Intersect(Target, Me.Range(sRng)) Is Nothing Then

    Application.EnableEvents = False

    With Target

        sNew = .Value2
        Application.Undo
        sOld = .Value2
        .Value2 = sNew

        Application.EnableEvents = True

        sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld


        If .Comment Is Nothing Then
            .AddComment
        Else
            iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
        End If

        With .Comment.Shape.TextFrame
            .AutoSize = True
            .Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
        End With

    End With

End If

End Sub


user2836976 February 2016

Here is the final code that got me the desired behavior. I changed the first IF statement according to @Scott Holtzman's comment. The IF statement now resets Application.EnableEvents = True before ending the macro with End Sub

EDIT: Included "Me." in "Me.range(sRng)"

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

'If (Target.Row > 3 And Target.Row < 155) Then Cells(Target.Row, "AT") = Now()

Const sRng As String = "A5:AQ155" ' change as required
Dim sOld As String
Dim sNew As String
Dim sCmt As String
Dim iLen As Long
Dim bHasComment As Boolean


With Target(1)
If Intersect(.Cells, Me.Range(sRng)) Is Nothing Then
Application.EnableEvents = True
Exit Sub
End If
sNew = .Text
sOld = .Text
.Value = sNew
Application.EnableEvents = True


sCmt = "Edit: " & Format$(Now, "dd Mmm YYYY hh:nn:ss") & " by " & Application.UserName & Chr(10) & "Previous Text :- " & sOld


If Target(1).Comment Is Nothing Then
.AddComment
Else
iLen = Len(.Comment.Shape.TextFrame.Characters.Text)
End If


With .Comment.Shape.TextFrame
.AutoSize = True
.Characters(Start:=iLen + 1).Insert IIf(iLen, vbLf, "") & sCmt
End With
End With
End Sub

Sub Hide_Comments_in_Workbook_Completely()
'This macro hides the comments and comment indicators - users wont know there is a comment within the excel workbook

Application.DisplayCommentIndicator = xlNoIndicator

End Sub

Post Status

Asked in February 2016
Viewed 1,525 times
Voted 9
Answered 2 times

Search




Leave an answer