Macros set up to move line NOT WORKING

[Ethel]

Hi,

I currently have a Macros running that moves a line from one sheet to another thats worked for months, i must have done something because now its not working properly! The line is disappearing from the 'active' sheet but not appearing on the 'completed sheet'.

Macros Module is-

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("All Rug Orders").UsedRange.Rows.Count
    J = Worksheets("Completed Rug Orders").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Completed Rug Orders").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("All Rug Orders").Range("R1:R" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Yes" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Completed Rug Orders").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Yes" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

VBA Code is-

Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Long
Dim xval As String
On Error Resume Next
If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For z = 1 To Target.Count
    If Target(z).Value > 0 Then
        Call Cheezy
    End If
Next
Application.EnableEvents = True

End Sub

 

[rlv01]

You are using the statement On Error Resume Next to turn off error checking for a large chunk of code. Personally, I am very careful about how and when I use that statement because errors are useful to tell you what & where the problem is (and you should turn error checking back on using On Error GoTo 0 as soon as possible).

Try temporarily removing statement On Error Resume Next, then re-run to get more information about the problem.

 

[NdNoviceHlp]

Hi Ethel. There's a couple of things you could trial. Remove the On Error Resume Next and see if there are any errors. The row copy I think should look like this...

Rows(xRg(K)).EntireRow.Copy Destination:=Worksheets("Completed Rug Orders").Range("A" & J + 1)
Rows(xRg(K)).EntireRow.Delete

HTH. Dave

 

[Ethel]

Hi Ethel. There's a couple of things you could trial. Remove the On Error Resume Next and see if there are any errors. The row copy I think should look like this...

Rows(xRg(K)).EntireRow.Copy Destination:=Worksheets("Completed Rug Orders").Range("A" & J + 1)
Rows(xRg(K)).EntireRow.Delete

HTH. Dave

No errors when removing On Error Resume Next
But adding the Rows xRg(K)) etc. the entire row.copy has become highlighted in error

 

[rlv01]

But adding the Rows xRg(K)) etc. the entire row.copy has become highlighted in error

What is the error message?

 

[NdNoviceHlp]

Maybe..

Worksheets("All Rug Orders").Rows(xRg(K)).EntireRow.Copy Destination:=Worksheets("Completed Rug Orders").Range("A" & J + 1)
 Worksheets("All Rug Orders").Rows(xRg(K)).EntireRow.Delete

Dave

 

[rlv01]

You could also try something a bit different.

Sub Cheezy()
    Dim xRg As Range, R As Range, rngDel As Range
    Dim J As Long, CopyCnt As Long, PasteCnt As Long
    
    J = Worksheets("Completed Rug Orders").UsedRange.Rows.Count

    If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Completed Rug Orders").UsedRange) = 0 Then J = 0
    End If

    PasteCnt = J

    With Worksheets("All Rug Orders")
        Set xRg = .Range("R1", .Range("R" & .Rows.Count).End(xlUp))
    End With

    Application.ScreenUpdating = False
    For Each R In xRg
        If Trim(R.Value) = "Yes" Then
            R.EntireRow.Copy Destination:=Worksheets("Completed Rug Orders").Range("A" & J + 1)
            CopyCnt = CopyCnt + 1
            If rngDel Is Nothing Then
                Set rngDel = R.EntireRow
            Else
                Set rngDel = Application.Union(rngDel, R.EntireRow)
            End If
            J = J + 1
        End If
    Next R
    
    If Not rngDel Is Nothing Then
        rngDel.Delete
    End If
    
    ''' Debug code
    PasteCnt = Worksheets("Completed Rug Orders").UsedRange.Rows.Count - PasteCnt
    Debug.Print CopyCnt & " rows were copied" & vbCr & PasteCnt & " rows were pasted"
    'MsgBox CopyCnt & " rows were copied" & vbCr & PasteCnt & " rows were pasted"
    ''' End debug code
    
    Application.ScreenUpdating = True
End Sub

 

[Ethel]

What is the error message?

Run-time error ‘13’:
Type mismatch

 

[Ethel]

I keep re writing the code. Sometimes it works and the line disappears but it doesn’t come up on the other sheet?
I’m desperate for this to get fixed!

 

[NdNoviceHlp]

What have you tried? My last code from #6? riv01's code? What were the results without the On error resume next? Dave