run time error '1004'__error in the method Delete for the class Range

Question

I have this code in the worksheet 1 and the macro won't cut and paste the "done" rows in the second sheet. the system says there is a run time error '1004'.. how can I solve this?

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim R As Range, OurValue As String

  If Not Intersect(Target, Columns(4), UsedRange) Is Nothing Then

    'code for Column D

    Set Target = Intersect(Target, Columns(4), UsedRange)

    OurValue = "done"

    Application.EnableEvents = False

    For Each R In Target

      If R = OurValue Then

        R.EntireRow.Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

        R.EntireRow.Delete shift:=xlUp

      End If

    Next

  ElseIf Not Intersect(Target, Columns(2), UsedRange) Is Nothing Then

    'code for Column A

    Set Target = Intersect(Target, Columns(2), UsedRange)

    Application.EnableEvents = False

    For Each R In Target

      If Not IsEmpty(R) And IsEmpty(R.Offset(0, 7)) Then

        R.Offset(0, 7) = Date

      End If

    Next

  ElseIf Not Intersect(Target, [E:E]) Is Nothing Then

    'code for Column E

    Set Target = Intersect(Target, [E:E])

    If Target.Cells.Count > 1 Then Exit Sub

    If Not Target.Locked Then

      Target.Worksheet.Unprotect 'optional password

      Target.Locked = True

      Target.Worksheet.Protect 'optional password

    End If

  End If

  Application.EnableEvents = True

End Sub

Answer 1

Just a note: In your code is missing an error handling. Therefore, the runtime error 1004 leaves the entire Excel Application without events. I highly recommend to insert an On-Error statement at the beginning of the event handler. At this point you can also turn off sheet protection and disable the events. Like this:

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim R As Range, OurValue As String

  On Error GoTo error_and_exit

  Application.EnableEvents = False

  ActiveSheet.Unprotect 'optional password

  If Not Intersect(Target, Columns(4), UsedRange) Is Nothing Then

    'code for Column D

    Set Target = Intersect(Target, Columns(4), UsedRange)

    OurValue = "done"

    For Each R In Target

      If R = OurValue Then

        R.EntireRow.Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

        R.EntireRow.Delete shift:=xlUp

      End If

    Next

  ElseIf Not Intersect(Target, Columns(1), UsedRange) Is Nothing Then

    'code for Column A

    Set Target = Intersect(Target, Columns(1), UsedRange)

    For Each R In Target

      If Not IsEmpty(R) And IsEmpty(R.Offset(0, 1)) Then

        R.Offset(0, 1) = Date

      End If

    Next

  ElseIf Not Intersect(Target, [E:E]) Is Nothing Then

    'code for Column E

    Set Target = Intersect(Target, [E:E])

    If Target.Cells.Count > 1 Then Exit Sub

    If Not Target.Locked Then Target.Locked = True

  End If

error_and_exit:

  ActiveSheet.Protect   'optional password

  Application.EnableEvents = True

End Sub

Peter

Answer 2

Probably the sheet is still protected - because of the action in column E. Then you can not delete rows and the following command will fail:

   R.EntireRow.Delete shift:=xlUp

Please try this instead.

ActiveSheet.Unprotect 'optional password

        R.EntireRow.Delete shift:=xlUp

        ActiveSheet.Protect   'optional password

Peter

Answer 3

Marta B. schrieb am 21.07.2010 16:01 Uhr:

yes yes yes!!!

thanks!!

You're welcome. But please see also the note in my other post in this thread.

Keywords: error-handling

Peter

Answer 4

yes yes yes!!!

thanks!!

Marta