Stopping a worksheet change event 1

[LGMan]

Hi, I have a worksheet change event which works fine as is, if new data is pasted into the range.
How can it be stopped if the range is cleared or deleted?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Long
Dim rng2 As Long
    With ActiveSheet
        rng = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

On Error Resume Next  'skip all run-time errors

Application.EnableEvents = False

If Target.Column > 4 Then

Range("A1:2" & rng).Copy
With Sheets("WTD")
rng2 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & rng2).PasteSpecial xlPasteAll
    End With
End If

Application.EnableEvents = True

On Error GoTo 0  'Turn off error trapping and re-allow run time errors

 MsgBox "Daily Data copied to the WTD Tab"

End Sub

 

[SkipVought]

Hi,


How can it be stopped if the range is cleared or deleted?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Long
Dim rng2 As Long[b]
Dim t As Range, bEmpty As Boolean

    bEmpty = True

    For Each t In Target
        If Len(t.Value) > 0 Then
           bEmpty = False
           Exit For
        End If
    Next

    If bEmpty Then Exit Sub[/b]

    With ActiveSheet
        rng = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

On Error Resume Next  'skip all run-time errors

Application.EnableEvents = False

If Target.Column > 4 Then

Range("A1:2" & rng).Copy
With Sheets("WTD")
rng2 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & rng2).PasteSpecial xlPasteAll
    End With
End If

Application.EnableEvents = True

On Error GoTo 0  'Turn off error trapping and re-allow run time errors

 MsgBox "Daily Data copied to the WTD Tab"

End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[LGMan]

Thanks Skip, I was struggling with the logic as the cell was being changed so why wouldn't of the course the change event trigger. Try as I might I couldn't get a workaround to work.
Your solution as ever is simple but elegant.
Cheers.

 

[combo]

rng is Long, I have two errors after:
[tt]Dim rng As Long
rng = 5
MsgBox ActiveSheet.Range("A1:2" & rng)
MsgBox ActiveSheet.Range("A1:2" & rng).Address[/tt]
due to range reference syntax. What range do you need to copy?


combo

 

[LGMan]

Hi Combo, dont know what happened there as the range is ("A1:C" & rng) it was after midnight here in the UK though :-(