Excel automatically add comment with cell edit history

Question

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?

Answer 1

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