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

 

[Ethel]

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

This seems to have worked.
Do you know a code for it so do it automatically?
So if we’re to add yes to column r is goes straight to the completed sheet. I had this working before. But now it’s not

 

[Ethel]

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

Tried removing and it didn’t work
But the above code rvl01 has sent seems to work, I just need it now to do it automatically

 

[rlv01]

This seems to have worked.
Do you know a code for it so do it automatically?

You should just be able to call it from your sub.

So if we’re to add yes to column r is goes straight to the completed sheet. I had this working before. But now it’s not

I tested it and it works for me if I add "Yes" to column R

 

[Ethel]

This seems to have worked.
Do you know a code for it so do it automatically?
So if we’re to add yes to column r is goes straight to the completed sheet. I had this working before. But now it’s not

Hiya! I’ve just changed the column to U, what do I need to change on this for it to work

 

[rlv01]

Hiya! I’ve just changed the column to U, what do I need to change on this for it to work

Read through the code for Sub Cheesy and find the places where it references Column R or a range in Column R and change those places so that it references Column U instead.

 

[Ethel]

Read through the code for Sub Cheesy and find the places where it references Column R or a range in Column R and change those places so that it references Column U instead.

I’ve friend but I’m not sure I have all of them

 

[rlv01]

Why don't you post what you have so far.

 

[Ethel]

Why don't you post what you have so far.

I deleted it
I’ve tried so many different things!

 

[Alex Blakenburg]

If you use @rlv01's solution in Post #7 and you want to point it at Column U, you should only need to change this line in Cheezy to U:

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

If you are using the change event you are probably also going to want to change the check there to point to U

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

 

[Ethel]

I currently have the below and it is only removing the line from the main sheet and not pasting to the completed sheet...... im so confused

Sub movebasedonvalue()
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("U1", .Range("U" & .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