VBA Help - Avoid triggering a Change Event on Delete

[Phantom]

Hi,

I've tried this for several hours before registering into the forums, I looked and experimented a lot, but I guess this is just beyond me.

I have zero prior experience with VBA or programming.

All I'm trying to do is to log the time when the contents of a Cell is changed. I've managed to do that by looking around the Web (this is the first time messing with VBA). Since the example I found was only for a single range, I added other "IFs" by myself.

All ranges are working and logging the time when they are changed. The problem is that when I delete the contents of the cells it triggers some king of cyclic event updating every other cell in the "vertical" axis of the spreadsheet.

I've managed to figure out that what I should be looking for seems to be a way to avoid triggering a change event when what I'm doing is deleting the contents of the cells, I've read and read, but I guess VBA language is just beyond me at this moment. So please don't think I'm lazy for asking the exact code, if you can provide me.

Summary: What I would like to do is to avoid triggering a Change Event when I delete the contents of any of the cells within these ranges. Sorry for my english.

This is what I'm using so far:


Private Sub Worksheet_Change(ByVal Target As Range)


If Not Intersect(Target, Range("E3:E1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If


If Not Intersect(Target, Range("G3:G1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If


If Not Intersect(Target, Range("i3:i1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If

If Not Intersect(Target, Range("k3:k1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If

If Intersect(Target, Range("m3:m1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If


End Sub

[p45cal]

You missed a Not!
Change:
If Intersect(Target, Range("m3:m1000")) Is Nothing Thento:

If Not Intersect(Target, Range("m3:m1000")) Is Nothing Then
This by itself should solve it, but to be really safe you can add a couple of lines around each change the macro makes to avoid triggering the change event again, eg.:
If Not Intersect(Target, Range("k3:k1000")) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 1) = Now()
Application.EnableEvents = True
End If

You could put the same two lines around all the code in the macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False

If Not Intersect(Target, Range("E3:E1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If
If Not Intersect(Target, Range("G3:G1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If
If Not Intersect(Target, Range("i3:i1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If
If Not Intersect(Target, Range("k3:k1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If
If Not Intersect(Target, Range("m3:m1000")) Is Nothing Then
Target.Offset(0, 1) = Now()
End If

Application.EnableEvents = True
End Sub


Or you could reduce the macro code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E3:E1000,G3:G1000,I3:I1000,K3:K1000,M3:M1000")) Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 1) = Now()
Application.EnableEvents = True
End If
End Sub


However, if someone with any of the code above should copy a block of cells more than one column wide to the area in question you'll end up with a mess. To help avoid that:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each cll In Target.Cells
If Not Intersect(cll, Range("E3:E1000,G3:G1000,I3:I1000,K3:K1000,M3:M1000")) Is Nothing Then
cll.Offset(0, 1) = Now()
End If
Next cll
Application.EnableEvents = True
End Sub

[Paul_Hossler]

Maybe if you only want the first cell in a multi-cell change



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Cells(1, 1).Row < 3 Or Target.Cells(1, 1).Row > 1000 Then Exit Sub


Select Case Target.Cells(1, 1).Column
Case 5, 7, 9, 11, 13
Application.EnableEvents = False
Target.Cells(1, 1).Offset(0, 1) = Now()
Application.EnableEvents = True
End Select


End Sub





If you want all cells in a multi-cell change



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range

For Each c In Target.Cells
If c.Row >= 3 And c.Row <= 1000 Then
Select Case c.Column
Case 5, 7, 9, 11, 13
Application.EnableEvents = False
c.Offset(0, 1) = Now()
Application.EnableEvents = True
End Select
End If
Next

End Sub




BUT the subject includes "Delete" so if you do NOT want to log the time, then something like this in the right place




If Len(c.value) > 0 then

.....


Endif