Excel Master Required: macro to append new text to existing cell comment

[darro]

Hi all, I have a macro that inserts a cell comment into the active cell, and I have adjusted the shape and font to my needs, but... what i want to be able to do is then select the cell with added comment and using same macro (ideally) append new text to the comment preserving the original text.

So ctrl K inserts new comment if no comment exists but ctrl K also opens the comment in edit mode if it already exists. Do you see?

The macro as I have it is below, any help would be much appreciated.
I await your excel mastery!

Sub AddNewCom()
     
    Dim strCommentName As String
    Dim cmnt As String
    Dim Today
    Today = Now
    cmnt = InputBox("Please enter a comment")
    strCommentName = "User:    " & cmnt & vbLf & Now
    On Error GoTo 0

  
    If Not activeCell.Comment Is Nothing Then GoTo 0
     
    With activeCell.AddComment(strCommentName)
        .Visible = False
        .Shape.AutoShapeType = msoShapeRoundedRectangle
        With .Shape.TextFrame
            With .Characters(0, Len("Greer:")).Font
                .Bold = True
                .Italic = True
                .ColorIndex = 3
            End With
        End With
    End With
    With activeCell
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Visible = False
    End With
    
    Exit Sub
     
0:
    
    If Err.Number <> 0 Then MsgBox Err.Description
     
End Sub

 

[xld]

Sub AddNewCom()
Dim strCommentName As String
Dim cmnt As String
    
    cmnt = InputBox("Please enter a comment")
    strCommentName = cmnt & vbLf & Now
    On Error GoTo 0

    With ActiveCell
    
        If .Comment Is Nothing Then
        
            strCommentName = "User:" & Chr(10) & strCommentName
        Else
    
            strCommentName = .Comment.Text & Chr(10) & strCommentName
            .Comment.Delete
        End If
     
        With .AddComment(strCommentName)
            .Visible = False
            .Shape.AutoShapeType = msoShapeRoundedRectangle
            With .Shape.TextFrame
                With .Characters(0, Len("Greer:")).Font
                    .Bold = True
                    .Italic = True
                    .ColorIndex = 3
                End With
            End With
        End With
        
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Visible = False
    End With
     
End Sub

 

[darro]

hi, thanks for quick reply, am I right in thinking this would delete the original comment? If so, I need it to let me add to it.

 

[xld]

Try it and see.

 

[darro]

I've just tried it, it works, you are clearly an excel master, one more thing. Can it be made to enter new text beneath the original. For example as if new text had been returned down a line? I'm assuming that vbLf would be required.

 

[xld]

You mean like this?

Sub AddNewCom()
Dim strCommentName As String
Dim cmnt As String
    
    cmnt = InputBox("Please enter a comment")
    strCommentName = cmnt & vbLf & Now
    On Error GoTo 0

    With ActiveCell
    
        If .Comment Is Nothing Then
        
            strCommentName = "User:" & Chr(10) & strCommentName
        Else
    
            strCommentName = .Comment.Text & Chr(10) & Chr(10) & strCommentName
            .Comment.Delete
        End If
     
        With .AddComment(strCommentName)
            .Visible = False
            .Shape.AutoShapeType = msoShapeRoundedRectangle
            With .Shape.TextFrame
                With .Characters(0, Len("Greer:")).Font
                    .Bold = True
                    .Italic = True
                    .ColorIndex = 3
                End With
            End With
        End With
        
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Visible = False
    End With
     
End Sub

 

[darro]

OK I have done that, perfect. Thanks very much, a big help. Maybe you can get a mastery badge from somewhere.

 

[darro]

Sorry, our posts crossed. Your newer code didn't change it. I changed it to this:

cmnt = InputBox("Please enter a comment")
    strCommentName = cmnt & vbLf & Now

and it works perfectly.
</pre>

 

[darro]

sorry, to this...

cmnt = InputBox("Please enter a comment")
    strCommentName = cmnt & vbLf & Now & vbLf

and it works perfectly.
</pre>

 

[darro]

Actually, there is another improvement. I have made it so the name of the person starts the new comment but can it be formatted bold, italic & red like in the original text?