Solved: Add to comment?

[blackie42]

Hi,

Got the following to prompt a user to insert comment on changing cell contents within a range (that code held in worksheet change event calling the below code)

[VBA]Sub InsertCommentsSelection()
Dim sCmt As String
Dim rCell As Range
sCmt = InputBox( _
Prompt:="Enter Comment to Add", Title:="Comment to Add")
If sCmt = "" Then
MsgBox "No comment added"
Else
For Each rCell In Selection
With rCell
.ClearComments
.AddComment
.Comment.Text Text:=sCmt
.Comment.Visible = False
End With
Next
End If
Set rCell = Nothing
End Sub[/VBA]

I'd like to be able to prefix the comment with the application Username (as it does if its added without VBA) but can't seem to get it to work.

Also is it possible (and how if so) to be able to update the comment if the cell contents change again (without wiping off the original comment)

many thanks for your help
Jon

[Bob Phillips]

[vba]

Sub InsertCommentsSelection()
Dim sCmt As String
Dim sName As String
Dim rCell As Range
sName = Environ("Username") & ":"
sCmt = InputBox( _
Prompt:="Enter Comment to Add", Title:="Comment to Add")
If sCmt = "" Then
MsgBox "No comment added"
Else
For Each rCell In Selection
With rCell
.ClearComments
.AddComment
.Comment.Text Text:=sName & Chr(10) & sCmt
.Comment.Visible = False
End With
Next
End If
Set rCell = Nothing
End Sub
[/vba]

[blackie42]

Hi Bob,

Thanks for adding username

Any way to stop the 2nd comment overwriting the first?

Jon

[Bob Phillips]

Try this

[vba]

Sub InsertCommentsSelection()
Dim sCmt As String
Dim sName As String
Dim rCell As Range
Dim cmt As Comment

sName = Environ("Username") & ":"
sCmt = InputBox( _
Prompt:="Enter Comment to Add", Title:="Comment to Add")
If sCmt = "" Then

MsgBox "No comment added"
Else

For Each rCell In Selection

With rCell

On Error Resume Next
Set cmt = .Comment
On Error GoTo 0
If cmt Is Nothing Then

.AddComment
.Comment.Text Text:=sName & Chr(10) & sCmt
Else

.Comment.Text .Comment.Text & Chr(10) & sName & Chr(10) & sCmt
End If

.Comment.Visible = False
.Comment.Shape.TextFrame.AutoSize = True
End With
Next
End If
Set rCell = Nothing
End Sub
[/vba]

[blackie42]

Excellent - thanks for your help

regards

Jon