Code WAY too slow... (worksheet_change event)

[john]

I am working with a spreadsheet that has several thousand rows. I
wanted to be able to track when rows have been added or updated so I
wrote a simple macro that adds the current date to the last column
whatever row changed.

'Private Sub Worksheet_Change(ByVal Target As Range)
'For Each cell In Target
' Sheet9.Cells(cell.Row, 19) = Date
' Application.EnableEvents = True
'Next cell
'End Sub

This works great when someone simply changes a value, but if I add a
NEW row (by copying a line and inserting it below) the code above takes
nearly a minute to complete. How can I make it faster?

 

[Jim Rech]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Application.EnableEvents = False
For Each Cell In Target.Columns(1).Cells
Cells(Cell.Row, 9) = Date
Next Cell
Application.EnableEvents = True
End Sub


--
Jim Rech
Excel MVP
|I am working with a spreadsheet that has several thousand rows. I
| wanted to be able to track when rows have been added or updated so I
| wrote a simple macro that adds the current date to the last column
| whatever row changed.
|
| 'Private Sub Worksheet_Change(ByVal Target As Range)
| 'For Each cell In Target
| ' Sheet9.Cells(cell.Row, 19) = Date
| ' Application.EnableEvents = True
| 'Next cell
| 'End Sub
|
| This works great when someone simply changes a value, but if I add a
| NEW row (by copying a line and inserting it below) the code above takes
| nearly a minute to complete. How can I make it faster?
|

 

[Guest]

Add application.enableevents = false at the very beginning of the code.
Without this the change event will call itself recursively...

 

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell
Application.EnableEvents = False
On Error GoTo ws_exit
For Each cell In Target
Sheet2.Cells(cell.Row, 19) = Date
Application.EnableEvents = True
Next cell
ws_exit:
Application.EnableEvents = True
End Sub


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Sharad Naik]

Try this then:
Dim myRange As Range, r
Set myRange = Target.EntireRow
For Each r In myRange.Rows
Sheet9.Cells(r.Row, 19) = Date
Next

But if the User is really going to pastes hundreds of rows
then the below code would be better:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range, r
Dim cRange As Range, i
Set myRange = Target.EntireRow
If myRange.Rows.Count = 1 Then
Sheet9.Cells(myRange.Row, 19) = Date
Else
Set cRange = Sheet9.Cells(myRange.Cells(1, 1).Row, 19)
i = 2
For i = 2 To myRange.Rows.Count
Set cRange = Union(cRange, Sheet2.Cells _
(myRange.Cells(i, 1).Row, 19))
Next i
cRange = Date
End If
End Sub