Applying worksheet_change code to original selection

[aalansari]

I have a code that adds comments to the selected cell whenever it is edited or its contents are deleted (something like "Edited/Deleted on 1/19/18 at 3:00PM"). I disabled the return key from moving the selection down, since the comment gets added to the new selection (below the cell). However, if you edit the cell and press any of the directional keys or tab or even select any other cell with the cursor the comment gets added there.
Is there any way to restrict that to the original cell that was modified?

 

[davesexcel]

What does the code look like?

 

[aalansari]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range


r = Selection.Row
c = Selection.Column


'Target Cell
Set rng = Sheet1.Cells(r, c)


'Checks if cell is blank and has no comment
If rng.Value = "" And rng.Comment Is Nothing Then
    Sheet1.Unprotect Password:="pass"
    rng.AddComment "Cell value was deleted on " & Now & "."
'Checks if cell is blank but has comment
ElseIf rng.Value = "" Then
    Sheet1.Unprotect Password:="pass"
    rng.Comment.Text "Cell value was deleted on " & Now & "." & vbLf, , False


Else
    'Adds comment if cell isn't blank, but contains a comment
       If rng.Value <> "" And rng.Comment Is Nothing Then
                Sheet1.Unprotect Password:="pass"
                rng.AddComment "Cell value was edited on " & Now & "."
            Else
            'Appends comment
                    Sheet1.Unprotect Password:="pass"
                    rng.Comment.Text "Cell value was edited on " & Now & ". " & vbLf, , False
                    rng.Comment.Shape.TextFrame.AutoSize = True
            'Auto-sizing comment
                    If rng.Comment.Shape.Width > 300 Then
                        lArea = rng.Comment.Shape.Width * rng.Comment.Shape.Height
                         rng.Comment.Shape.Width = 200
                        ' An adjustment factor of 1.1
                         ' seems to work ok.
                         rng.Comment.Shape.Height = (lArea / 200) * 1.1
                    End If
        End If
    
End If


'Protects the sheet
protector




End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


r = Selection.Row
c = Selection.Column


'Unlocks the cell if only a single cell is selected
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
    Sheet1.Cells(r, c).Locked = False
End If




End Sub

 

[Fluff]

The quickest way would be to change this

Set rng = Sheet1.Cells(r, c)

to

Set rng = Target

Also when you receive a message to the effect that your post has been put into moderated status. Please be patient & wait for a moderator to deal with it, rather than repost as you did above. Thanks

 

[aalansari]

That worked! I learned 2 things today

Thanks a lot!