Hi,
The following code should:
1) add a comment with text & date when a date is entered in a cell in 'I'
2) append the above comment with new text and date when a date is entered in
'J'

The first part works fine, but the second doesn't and I can't figure out why!

Private Sub Worksheet_Change(ByVal Target As Range)

'adds a comment box to cells in column K (if an "Certificate of Service"
date is entered
On Error Resume Next
If Not Intersect(Target, Me.Range("I6:I30")) Is Nothing Then
With Target
If .Value <> "" Then
Application.EnableEvents = False
Target.Offset(0, 2).AddComment.Text Text:="AoS due date: " &
Target.Value + 14
On Error GoTo 0
Application.EnableEvents = True
End If
End With
End If

'appends the comment box in cells in column K if a "Particulars of Claim"
date is entered
On Error Resume Next
If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
With Target
If .Value <> "" Then
Application.EnableEvents = False
Target.Offset(0, 1).EditComment.Text Text:="Due date: " &
Target.Value + 14
On Error GoTo 0
Application.EnableEvents = True
End If
End With
End If
End Sub


Any ideas?
Thanks
--
Traa Dy Liooar

Jock

You need to store the comment to a variable and delete and set the comment
again.

'date is entered
On Error Resume Next
If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
With Target
If .Value <> "" Then
Application.EnableEvents = False
If Target.Offset(0, 1).Comment Is Nothing Then
Target.Offset(0, 1).AddComment.Text Text:="Due date: " &
Target.Value + 14
Else
strTemp = Target.Offset(0, 1).Comment.Text
Target.Offset(0, 1).ClearComments
Target.Offset(0, 1).AddComment.Text Text:=strTemp & " Due date: " &
Target.Value + 14
End If

On Error GoTo 0
Application.EnableEvents = True
End If
End With
End If



--
If this post helps click Yes
---------------
Jacob Skaria


"Jock" wrote:

> Hi,
> The following code should:
> 1) add a comment with text & date when a date is entered in a cell in 'I'
> 2) append the above comment with new text and date when a date is entered in
> 'J'
>
> The first part works fine, but the second doesn't and I can't figure out why!
>
> Private Sub Worksheet_Change(ByVal Target As Range)
>
> 'adds a comment box to cells in column K (if an "Certificate of Service"
> date is entered
> On Error Resume Next
> If Not Intersect(Target, Me.Range("I6:I30")) Is Nothing Then
> With Target
> If .Value <> "" Then
> Application.EnableEvents = False
> Target.Offset(0, 2).AddComment.Text Text:="AoS due date: " &
> Target.Value + 14
> On Error GoTo 0
> Application.EnableEvents = True
> End If
> End With
> End If
>
> 'appends the comment box in cells in column K if a "Particulars of Claim"
> date is entered
> On Error Resume Next
> If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
> With Target
> If .Value <> "" Then
> Application.EnableEvents = False
> Target.Offset(0, 1).EditComment.Text Text:="Due date: " &
> Target.Value + 14
> On Error GoTo 0
> Application.EnableEvents = True
> End If
> End With
> End If
> End Sub
>
>
> Any ideas?
> Thanks
> --
> Traa Dy Liooar
>
> Jock

Can also do it without deleting the comment

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
Dim v
On Error GoTo errExit
If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
With Target(1)
v = .Value
If IsDate(v) Then
s = "Due date: " & v + 14
If .Offset(0, 1).Comment Is Nothing Then
.Offset(0, 1).AddComment.Text Text:=s
Else
With .Offset(0, 1).Comment
s = vbLf & s
.Text Text:=.Text = s
End With
End If
End If
End With
End If

errExit:
End Sub

If you want to preserve existing formatting change
.Text Text:=.Text = s
to
.Shape.TextFrame.Characters(Len(.Text), Len(s)).Text = s

No need to disable events for this

Regards,
Peter T


"Jock" <(E-Mail Removed)> wrote in message
news:2F5006FC-4201-4757-9CEF-(E-Mail Removed)...
> Hi,
> The following code should:
> 1) add a comment with text & date when a date is entered in a cell in 'I'
> 2) append the above comment with new text and date when a date is entered
> in
> 'J'
>
> The first part works fine, but the second doesn't and I can't figure out
> why!
>
> Private Sub Worksheet_Change(ByVal Target As Range)
>
> 'adds a comment box to cells in column K (if an "Certificate of Service"
> date is entered
> On Error Resume Next
> If Not Intersect(Target, Me.Range("I6:I30")) Is Nothing Then
> With Target
> If .Value <> "" Then
> Application.EnableEvents = False
> Target.Offset(0, 2).AddComment.Text Text:="AoS due date: " &
> Target.Value + 14
> On Error GoTo 0
> Application.EnableEvents = True
> End If
> End With
> End If
>
> 'appends the comment box in cells in column K if a "Particulars of Claim"
> date is entered
> On Error Resume Next
> If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
> With Target
> If .Value <> "" Then
> Application.EnableEvents = False
> Target.Offset(0, 1).EditComment.Text Text:="Due date: " &
> Target.Value + 14
> On Error GoTo 0
> Application.EnableEvents = True
> End If
> End With
> End If
> End Sub
>
>
> Any ideas?
> Thanks
> --
> Traa Dy Liooar
>
> Jock

Great stuff.
When the comment is set again, can it be formatted with strikethrough to
make it obvious it's not the most recent addition?
Thanks
--
Traa Dy Liooar

Jock


"Jacob Skaria" wrote:

> You need to store the comment to a variable and delete and set the comment
> again.
>
> 'date is entered
> On Error Resume Next
> If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
> With Target
> If .Value <> "" Then
> Application.EnableEvents = False
> If Target.Offset(0, 1).Comment Is Nothing Then
> Target.Offset(0, 1).AddComment.Text Text:="Due date: " &
> Target.Value + 14
> Else
> strTemp = Target.Offset(0, 1).Comment.Text
> Target.Offset(0, 1).ClearComments
> Target.Offset(0, 1).AddComment.Text Text:=strTemp & " Due date: " &
> Target.Value + 14
> End If
>
> On Error GoTo 0
> Application.EnableEvents = True
> End If
> End With
> End If
>
>
>
> --
> If this post helps click Yes
> ---------------
> Jacob Skaria
>
>
> "Jock" wrote:
>
> > Hi,
> > The following code should:
> > 1) add a comment with text & date when a date is entered in a cell in 'I'
> > 2) append the above comment with new text and date when a date is entered in
> > 'J'
> >
> > The first part works fine, but the second doesn't and I can't figure out why!
> >
> > Private Sub Worksheet_Change(ByVal Target As Range)
> >
> > 'adds a comment box to cells in column K (if an "Certificate of Service"
> > date is entered
> > On Error Resume Next
> > If Not Intersect(Target, Me.Range("I6:I30")) Is Nothing Then
> > With Target
> > If .Value <> "" Then
> > Application.EnableEvents = False
> > Target.Offset(0, 2).AddComment.Text Text:="AoS due date: " &
> > Target.Value + 14
> > On Error GoTo 0
> > Application.EnableEvents = True
> > End If
> > End With
> > End If
> >
> > 'appends the comment box in cells in column K if a "Particulars of Claim"
> > date is entered
> > On Error Resume Next
> > If Not Intersect(Target, Me.Range("J5:J30")) Is Nothing Then
> > With Target
> > If .Value <> "" Then
> > Application.EnableEvents = False
> > Target.Offset(0, 1).EditComment.Text Text:="Due date: " &
> > Target.Value + 14
> > On Error GoTo 0
> > Application.EnableEvents = True
> > End If
> > End With
> > End If
> > End Sub
> >
> >
> > Any ideas?
> > Thanks
> > --
> > Traa Dy Liooar
> >
> > Jock