Hello Everyone,
I have hopefully a simple issue to solve. Most likely me just being confused and missing something simple.
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.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
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.
https: // i.imgur.com/32J31tf.gifPrivate 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
Bookmarks