Auto Comment When a cell value is being changed

Shinod

New Member
Joined
Jun 29, 2022
Messages
38
Office Version
  1. 2019
Platform
  1. Windows
Hi, Can someone help me to correct this VBA?

I was looking for a VBA which gives auto comment when I change a value in any cell. I got a code that is more similar to my expectation.

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    val_before = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then
        MsgBox Target.Count & " cells were changed!"
        Exit Sub
    End If

    If Target.Comment Is Nothing Then
        Target.AddComment
        existingcomment = ""
    Else
        existingcomment = Target.Comment.Text & vbLf & vbLf
    End If

    Target.Comment.Text Text:=Format(Now(), "DD.MM.YYYY hh:mm") & ":" & vbLf & Environ("UserName") & _
        " changed " & val_before & Target.Address & " from:" & vbLf & """" & val_before & _
        """" & vbLf & "to:" & vbLf & """" & Target.Value & """"

End Sub

This code is working. But in the comment, it is not showing what was the previous value.

Also, I want multiple lines of comment if the amendment was done multiple times. Also is it possible to change the default comment box size?

I added this VBA by right-clicking the sheet name>View code>and pasting this code there? Is it the correct way to do it?


File is attached here.



Thanks in Advance
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
You need the global variables first so you can pass them to the other sub.

VBA Code:
Dim val_before
Dim comment_before As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 8 Then
    comment_before = ""
        val_before = Target.Value
        Dim c As Comment
        With Target
            On Error Resume Next
            Set c = .Comment
            On Error GoTo 0
            If c Is Nothing Then
            Else
                comment_before = c.Text
            End If
        End With
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Column = 8 Then

        If Target.Comment Is Nothing Then
            Target.AddComment
            existingcomment = ""
        Else
            existingcomment = Target.Comment.Text & vbLf & vbLf
        End If
        Application.EnableEvents = False
        Target.Comment.Text Text:=comment_before & vbNewLine & _
                                   Format(Now(), "DD.MM.YYYY hh:mm") & ":" & Environ("UserName") & _
                                   " changed " & Target.Address & " from: " & """" & val_before & _
                                   """" & " to: " & """" & Target.Value & """"
        Target.Comment.Shape.TextFrame.AutoSize = True
        Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Use only single sub for "change event"
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vOld, vNew, cNew As String, cOld As String, c
    If Intersect(Target, Columns("H")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then
            MsgBox Target.Count & " cells were changed!"
            Exit Sub
    End If
    vNew = Target.Value ' save the new value
    
    'use undo method to get old value before change
    Application.EnableEvents = False
    Application.Undo
    vOld = Target.Value ' get old value
    Target.Value = vNew 'reset target value to new value
    Application.EnableEvents = True
    
    'generate new comment. I re-arrange the text to see it clearer. adjust it if you want
    cNew = Format(Now(), "DD.MM.YYYY hh:mm") & ": " & Target.Address & " changed from: " & vOld & _
                " to: " & Target.Value & " by : " & Environ("UserName")
                
    'combine old and new comment
    Set c = Target.Comment
    If Not c Is Nothing Then
        cOld = Target.Comment.Text ' save old comment
        Target.Comment.Delete ' delete old comment
        cNew = cOld & vbLf & cNew ' combine old & new comment
    End If
    
    ' create new final comment and auto fit
    Target.AddComment (cNew)
    Target.Comment.Shape.TextFrame.AutoSize = True
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,215,248
Messages
6,123,873
Members
449,130
Latest member
lolasmith

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top