problem with MovebasedonValue function

I am using the code below to move rows from one worksheet to another when "Done" is selected from a drop down menu.?* It worked fine on my computer and when I first shared with another user however now it freezes excel and you have to restart the program.?* She (other user) is on a network shared folder; i am not.?* Can anyone help??* I have included code below.

Sub MoveBasedOnValue()



Dim xRg As Range

Dim xCell As Range

Dim A As Long

Dim B As Long

Dim C As Long

A = Worksheets("master").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("master").Range("AC7:AC" & A)

On Error Resume Next

Application.ScreenUpdating = False

For C = 1 To xRg.Count

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

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

xRg(C).EntireRow.Delete

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

C = C - 1

End If

B = B + 1

End If

Next

Application.ScreenUpdating = True

End Sub



Private Sub Worksheet_Change(ByVal Target As Range)

Dim Z As Long

Dim xVal As String

On Error Resume Next

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

Application.EnableEvents = False

For Z = 1 To Target.Count

If Target(Z).Value > 0 Then

Call MoveBasedOnValue

End If

Next

Application.EnableEvents = True

End Sub

Step through the code using F8. Check the value of xRg.Count. I suspect the Used Range may be very high for some reason. I think that Excel is not actually freezing, just taking a long time to work through a lot of rows.

If you want to stick to a 2 sub solution change both subs to this.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("AC:AC")) Is Nothing Then

        If Target.Value = "Done" Then
        
            Application.EnableEvents = False
    
            wRow = Target.Row: Call MoveBasedOnValue: wRow = 0
            
            Application.EnableEvents = True
        
        End If
        
    End If


    
End Sub

and

Public wRow As Long

Sub MoveBasedOnValue()

    Dim B As Long

    B = Sheets("completed").Range("B" & Rows.Count).End(xlUp).Row 'Worksheets("completed").UsedRange.Rows.Count

    If B = 1 Then
    
        If Application.CountA(Worksheets("completed").UsedRange) = 0 Then B = 0
    
    End If

    Application.ScreenUpdating = False

    With Sheets("master")
        
        .Unprotect
    
        .Rows(wRow).EntireRow.Copy Sheets("completed").Range("A" & B + 1)
    
        .Rows(wRow).EntireRow.Delete xlUp
        
        .Protect
        
    End With
    
    Application.ScreenUpdating = True

End Sub