drag and drop and Worksheet_Change

[Guest]

Dear experts,
I have a code that uses the Worksheet_Change event to insert a comment
object in the changed cell with the name of the user and the date.
I have noticed, though, that if users drag and drop a cell onto a second
one, VBA considers that the 2 cells have been changed (as target), when in
reality only the second one has been changed!
Is there something I can do about this? My code is below.
Many thanks,
best regards,
Valeria

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vvvrange As Range
Dim cell As Object
Set vvvrange = Range("Comment_Input")
Application.EnableEvents = False
On Error Resume Next
For Each cell In Target
If Union(cell, vvvrange).Address = vvvrange.Address Then
cell.Comment.Delete
cell.AddComment
cell.Comment.Visible = False
cell.Comment.Text Text:=Application.UserName & Chr(10) & Format(Date,
"DD-MMM-YYYY")
cell.Comment.Shape.TextFrame.AutoSize = True
End If
Next cell
On Error GoTo 0
Application.EnableEvents = True

 

[Guest]

"in reality" two cells have changed - if you drag B2 to D4, then your'e
basically clearing B2, first change, and entering that cell's values into D4,
second change.
However, "target" doesn't have two vaues as such. what happens is that the
event fires twice, once for the "cut" then again for the "paste"

look at the immediate window using this code, after a drag/drop
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address
End Sub

Changing your code to this may help:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vvvrange As Range
Dim cell As Range
Set vvvrange = Intersect(Range("Comment_Input"), Target)
If Not vvvrange Is Nothing Then
For Each cell In vvvrange.Cells
cell.ClearComments
cell.AddComment
cell.Comment.Visible = False
cell.Comment.Text Text:=Application.UserName & Chr(10) & _
Format(Date, cell.Comment.Shape.TextFrame.AutoSize = True)
Next
End If
End Sub

Method: with dragging , the first action, clearing the source cells, doen'd
dop anything since the "target" passed to the event handler produces no
intersect. The "drop" again fires the event, this time there is an intersect
and the comment gets added


HTH
Patrick Molloy
Microsoft Excel MVP

 

[Guest]

Hi,
thanks, unfortunately I still get the 2 comments for the 2 cells... actually
I do not want to clear the content of the first cell, I just want to copy it
(using the small black cross on the bottom right-hand side of the cell)... if
I use "copy" and then "paste", then only the second cell gets the comment;
when I use this draganddrop method, as you say, the code loops through the 2
cells!

Thanks,
best regards,
Valeria

 

[Tom Ogilvy]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vvvrange As Range
Dim cell As Object
Set vvvrange = Range("Comment_Input")
Application.EnableEvents = False
On Error Resume Next
For Each cell In Target
If Union(cell, vvvrange).Address = vvvrange.Address _
and not iempty(cell) Then
cell.Comment.Delete
cell.AddComment
cell.Comment.Visible = False
cell.Comment.Text Text:=Application.UserName & Chr(10) & Format(Date,
"DD-MMM-YYYY")
cell.Comment.Shape.TextFrame.AutoSize = True
End If
Next cell
On Error GoTo 0
Application.EnableEvents = True


Is one possibility

 

[Guest]

Valerie,
Are you able to adapt this code:
I just tested it and fount that I could select a cell in MyRange, drag the
lower
right corner to copy down or to the right, WITHOUT it firing a 2nd time.

 

[Guest]

Hi,
which code are you talking about?
Many thanks,
best regards,
Valeria

 

[Guest]

I found a code that works.. it is not very elegant, but does the job...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vvvrange As Range
Dim cell As Object
dim x as integer
Set vvvrange = Range("Comment_Input")
Application.EnableEvents = False
x=0
On Error Resume Next
For Each cell In Target
If Union(cell, vvvrange).Address = vvvrange.Address Then
x = x + 1
If Target.Count = 2 And x = 2 Or Target.Count = 1 Then
cell.Comment.Delete
cell.AddComment
cell.Comment.Visible = False
cell.Comment.Text Text:=Application.UserName & Chr(10) & Format(Date,
"DD-MMM-YYYY")
cell.Comment.Shape.TextFrame.AutoSize = True
End If
End If
Next cell
On Error GoTo 0
Application.EnableEvents = True
ens sub

 

[Guest]

Sorry, I obviously left out the code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("TestRng")) Is Nothing Then 'adjust
TestRng
Application.EnableEvents = False
MsgBox "Hello"
'''Your code here

End If
Application.EnableEvents = True
End Sub