Excel crashing on macro

[Out]

Hello,

I am still very new to VBA and through tutorials have been trying to create a workbook that separates out rows by status in column I to different worksheets, that then deletes any duplicates.

The end goal here is to be able to drop 100 rows into the 'list' worksheet, and have those automatically moved to 'completed' or 'done'. However, if I paste more than 3 rows into the 'list' worksheet, excel starting spinning and crashes. These rows I am pasting usually go from A:AO. The macros work very nicely when changing statuses manually. Any ideas on why the VBA below would cause excel to crash?


List Worksheet code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Subscribe to youtube.com/excel10tutorial

Dim Z As Long

Dim xVal As String

On Error Resume Next

If Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then

Call MoveToCompleted
Call MoveToDone

End If

Next

Application.EnableEvents = True

End Sub

Move rows module(s) Both modules 'MoveToCompleted' and 'MoveToDone' are exactly the same, other than referring to "Done" worksheet instead of Completed like below.

Sub MoveToCompleted()

    Dim xRg As Range

    Dim xCell As Range

    Dim A As Long

    Dim B As Long

    Dim C As Long

    A = Worksheets("List").UsedRange.Rows.Count

    B = Worksheets("Completed").UsedRange.Rows.Count

    If B = 1 Then

       If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then B = 0

    End If

    Set xRg = Worksheets("List").Range("I1:I" & A)

    On Error Resume Next

    Application.ScreenUpdating = False

    For C = 1 To xRg.Count

        If CStr(xRg(C).Value) = "Completed" Then

            xRg(C).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & B + 1)

            xRg(C).EntireRow.Delete

            If CStr(xRg(C).Value) = "Completed" Then

                C = C - 1

            End If

            B = B + 1

        End If

    Next

    Application.ScreenUpdating = True

End Sub

The sheets these rows are sent to then call a module to delete any duplicate rows.

Done/Completed worksheet code

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Z As Long

    Dim xVal As String

    On Error Resume Next

    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    For Z = 1 To Target.Count

        If Target(Z).Value > 0 Then

            Call Delete_Duplicate_Rows_without_Headers

        End If

    Next

    Application.EnableEvents = True

End Sub

Delete Duplicates module

Sub Delete_Duplicate_Rows_without_Headers()

Range("A:AO").RemoveDuplicates Columns:=Array(1), Header:=xlNo

End Sub

Any help is appreciated.

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach screenshots (not pictures) of your sheet 3 sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).