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

 

[Alex Blakenburg]

I thought you had that working ?

But the above code rvl01 has sent seems to work, I just need it now to do it automatically

I suspect it is pasting just not to where you think it is.
Where is it supposed to paste ? To the next available row ?
If so which column will be always be populated for every row used ?

 

[Alex Blakenburg]

I have only made a couple of small changes to @rlv01's post 7 mainly around not using UsedRange to work out the last row but just to use Column B to determine the last row.
Also your change from column R to U is included.

See how you go.

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").Range("B" & Rows.Count).End(xlUp).Row

    If Worksheets("Completed Rug Orders").Range("B" & J) = "" Then J = 0
    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
    PasteCnt = J - 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
    
End Sub

 

[Ethel]

I thought you had that working ?

I suspect it is pasting just not to where you think it is.
Where is it supposed to paste ? To the next available row ?
If so which column will be always be populated for every row used ?

I did but i needed to add columns and change it slightly, now its not working

I'm wanting it to paste on the next available line on "Completed Rug Orders" sheet.

Sorry, i don't quite understand the last question.
I'd like the entire row to move from "All Rug Orders" to "Completed Rug Orders" if there is a "Yes" in Column U.

 

[Alex Blakenburg]

Come back to me after you have tried the code in my post #22

 

[rlv01]

Per your first post, the column containing the "Yes" (Col R) to trigger a move is labled "Customer Received". This version will search for that label so you can add or delete other columns and it will still work.

Sub Cheezy()
    Dim xRg As Range, R As Range, rngDel As Range
    Dim J As Long, CopyCnt As Long, PasteCnt As Long
    Dim YesCol As String, YesColHeader As String

    '****
    
    YesColHeader = "Customer Received"                '<- header text for Column containing "Yes" for move operation.
    
    '****
    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 rngRowData = .Range("B1", .Cells(1, .Columns.Count).End(xlToLeft))    'range of data in row
        For Each R In .Range("B1", .Cells(1, .Columns.Count).End(xlToLeft))
            If Replace(R.Value, Chr(10), " ") = YesColHeader Then
                YesCol = Split(R.Address, "$")(1)
            End If
        Next R
        If YesCol <> "" Then
            Set xRg = .Range(YesCol & "1", .Range(YesCol & .Rows.Count).End(xlUp))
        Else
            MsgBox "Error - Cannot find column '" & YesColHeader & "'"
            Exit Sub
        End If

    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

    Worksheets("Completed Rug Orders").UsedRange.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

 

[Ethel]

Come back to me after you have tried the code in my post #22

Hi Alex,

yes you are correct! they were further down the sheet for some reason...... but its working now
Thank you so much!

Come back to me after you have tried the code in my post #22

This worked yesterday, now i have a de-bug that highlightes the below
R.EntireRow.Copy Destination:=Worksheets("Completed Rug Orders").Range("A" & J + 1)

 

[Alex Blakenburg]

Do you know how to use the immediate window ?
If you remove the other Debug.Print lines and just before the line it errors out on put this line.

            Debug.Print "Cell R Address: " & R.Address & Chr(10) & "Value of J: " & J

What is the last line you see in the immediatee window before it errors out ?