Code to move row to a list

[loyola74]

Hi all,

This is my first post, so please bear with me. I'm definitely not good at VBA, but I'm continuing to learn as I design new templates and I use forums like these.

In the code below, I am taking any items that were delivered late on the "summary" worksheet and moving them to a list on the "delivered late" worksheet. The code looks for any item coded as delivered late, copies the row, pastes the row on the other sheet, deletes the original row, and looks again. My problem is that if I have something on the list, the code is overwriting it instead of adding at the bottom of the list. I have tried different things I found online, but I am always generating an error.

Thank you for your assistance. Here is the code I have:

Sub SpecialCopy()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
On Error GoTo Err_Execute
Application.ScreenUpdating = False

LSearchRow = 8
LCopyToRow = 8

While Len(Range("B" & CStr(LSearchRow)).Value) > 0
If Range("I" & CStr(LSearchRow)).Value = "DELIVERED - LATE" Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

Sheets("Delivered late").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

LCopyToRow = LCopyToRow + 1

Sheets("Summary").Select
End If
LSearchRow = LSearchRow + 1
Wend

LastRow = Cells(Rows.Count, "I").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("I" & i).Value = "DELIVERED - LATE" Then
Range("I" & i).EntireRow.Delete
End If
Next I


Application.CutCopyMode = False
Range("B8").Select
MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."
End Sub

 

[iggydarsa]

Re: Help with VBA - Code to move row to a list

Your code works just fine for me.
Before you run the code click somewhere in the procedure and hit F8 over and over to see where the code is failing to do the right stuff.
When the debugging line passes the line "LCopyToRow = LCopyToRow + 1", hover over "LCopyToRow" to see if the value is incremented successfully.

 

[Dim Me as xlNoob]

Re: Help with VBA - Code to move row to a list

Worked fine for me too, but I understood was that if there was already data in the list on the Delivered Late sheet then yes this code will overwrite it from row 8 onwards. Instead, set your LCopyToRow like this:

    With Sheets("Delivered Late")
        LCopyToRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    End With

 

[loyola74]

Re: Help with VBA - Code to move row to a list

Worked fine for me too, but I understood was that if there was already data in the list on the Delivered Late sheet then yes this code will overwrite it from row 8 onwards. Instead, set your LCopyToRow like this:

    With Sheets("Delivered Late")
        LCopyToRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    End With

That worked perfectly!

Thank for the help

 

[Fluff]

Re: Help with VBA - Code to move row to a list

Another option, avoiding the 2 loops is

Sub SpecialCopy()
    Dim UsdRws As Long
    
Application.ScreenUpdating = False
    
    With Sheets("Summary")
        UsdRws = .Range("I" & Rows.Count).End(xlUp).Row
        If .AutoFilterMode Then .AutoFilterMode = False
        .Range("A7:I7").AutoFilter 9, "DELIVERED - LATE"
        On Error GoTo Err_Execute
        .Range("A8:A" & UsdRws).SpecialCells(xlVisible).EntireRow.copy _
            Sheets("Delivered late").Range("I" & Rows.Count).End(xlUp).Offset(1, -8)
        .Range("A8:A" & UsdRws).SpecialCells(xlVisible).EntireRow.Delete
        .AutoFilterMode = False
    End With
        
    MsgBox "All matching data has been copied."
    
Exit Sub
    
Err_Execute:
    MsgBox "An error occurred."
    Sheets("Summary").AutoFilterMode = False
End Sub

 

[loyola74]

Re: Help with VBA - Code to move row to a list

Thank you Fluff. Definitely way above my head.

 

[Fluff]

Re: Help with VBA - Code to move row to a list

Your welcome