Issue: Pasted data causes VBA Macro to insert more data than intended

Hello Everyone,

I have hopefully a simple issue to solve. Most likely me just being confused and missing something simple.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng1 As Range
Dim rng2 As Range
Dim InRange As Boolean
Set rng1 = Range(Target.Address)
Set rng2 = Range("V8:V999")
Set InterSectRange = Application.Intersect(rng1, rng2)

On Error Resume Next
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
If InRange = True Then
rng1.Offset(0, 1).Value = Now()
End If

Set rng1 = Nothing
Set rng2 = Nothing

Dim rng3 As Range
Dim rng4 As Range
Dim InRange2 As Boolean
Set rng3 = Range(Target.Address)
Set rng4 = Range("A8:A999")
Set InterSectRange2 = Application.Intersect(rng3, rng4)

On Error Resume Next
InRange2 = Not InterSectRange2 Is Nothing
Set InterSectRange2 = Nothing
If InRange2 = True Then
rng3.Offset(0, 18).Value = Now()
End If

Set rng3 = Nothing
Set rng4 = Nothing

End Sub

In this code it is part 2 that is the problem. It works fully as intended when one places a date into column A. The result is the date/time when data is entered.
The key is this data is from a data base and is pasted into the spreadsheet from columns A to R. When this is done it fills out the date/time to the cell I want and then some, extending and overwriting all data till it hits the same number of columns as the pasted data.

I am guessing it is due to either traget.address or my inrange2 boolean that is causing the issue.

If anyone can help or suggest even simpler code I would appreciate that very much.

Attached are still images of the spreadsheet and also a copy of the file.

I tried to add a link to a gif to see in action but unable as my account is too new. (link here (remove spaces): https : //s6.gifyu.com/images/image1.gif)

Kind regards - Aaron

UPDATE:

As per posts below my code has been changed. But it does have an unintended issue. If a row is deleted it for some reason will add now() to the cell down 1 in column B. When none of the code specifically states anything to do with column B.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

If Not Intersect(Target, Me.Range("V8:V999")) Is Nothing Then Target.Resize(Target.Rows.Count, 1).Offset(0, 1).Value = Now()

If Not Intersect(Target, Range("A8:A999")) Is Nothing Then Target.Resize(Target.Rows.Count, 1).Offset(0, 18).Value = Now()

Application.EnableEvents = True

End Sub

https: // i.imgur.com/32J31tf.gif

Your current Worksheet_change() routine can be simplified to this:

Please Login or Register  to view this content.

The trouble is, when you paste a multi-column selection into the worksheet, Target.address will also be multi-cell and for each cell in that value the value of now() will be inserted into the offset cell.

What you need to do, is resize the target to 1 column only and then do the .offset.value from that, i.e.

Please Login or Register  to view this content.

Does that fix it?

Tim

Forgot to mention... I'd probably switch off Application.EnableEvents as a matter of routine with these Worksheet_change() subs... Here it won't make any difference, but if you end up adding more and more ranges which trigger some action it's very easy to end up with an infinite loop if you're not careful. So it should actually be

Please Login or Register  to view this content.

We've all done it!

Tim

Hmmm. That's a pain. How about we include a condition that aborts the Worksheet_Change() event if there are more than a given number of columns in the target range?

Please Login or Register  to view this content.

Then, you can paste columns A:R and it won't be captured, but if you delete a whole row the Worksheet_Change() will exit at the first statement. Feels like a bit of a hack, but if it works...

Tim