Macro to move rows in worksheets not working as expected?

[MeghanD]

Hi, we have used the following macro (its in 2 parts one to copy the other to delete from the original tab- because when we ran it all together it caused even more issues!) to move data based on codes onto 3 separate worksheets (active, completed & Cancelled) however when we run it only moves about 2 rows at a time and you have to run it over and over to get it to work on all of the data? Can anyone help

Sub MoveComplete()
Dim i, LastRow
Dim y
i = ""
y = ""
LastRow = ""

LastRow = Sheets("Active").Range("A" & Rows.Count).End(xlUp).Row
'Sheets("Sheet2").Range("A2:I500").ClearContents
For i = 2 To LastRow
If Sheets("Active").Cells(i, "J").Value = "VISU" Or Sheets("Active").Cells(i, "J").Value = "CTTV" Or Sheets("Active").Cells(i, "J").Value = "VISS" Then
Sheets("Active").Cells(i, "J").EntireRow.Copy Destination:=Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
LastRow = Sheets("Active").Range("A" & Rows.Count).End(xlUp).Row
For y = 2 To LastRow
If Sheets("Active").Cells(y, "J").Value = "VISC" Then
Sheets("Active").Cells(y, "J").EntireRow.Copy Destination:=Sheets("Cancelled").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next y

'deleteRowsTransferred
End Sub

*******************************************************************************

Sub deleteRowsTransferred()
Dim x, LastRowB
Dim z
LastRowB = ""
x = ""
z = ""
LastRowB = Sheets("Active").Range("A" & Rows.Count).End(xlUp).Row

For z = 2 To LastRowB
If Sheets("Active").Cells(z, "J").Value = "VISU" Or Sheets("Active").Cells(z, "J").Value = "VISC" Or Sheets("Active").Cells(z, "J").Value = "CTTV" Or Sheets("Active").Cells(z, "J").Value = "VISS" Then
Sheets("Active").Cells(z, "J").EntireRow.Delete
End If
Next z
LastRowB = Sheets("Active").Range("A" & Rows.Count).End(xlUp).Row
For w = 2 To LastRowB
If Sheets("Active").Cells(w, "J").Value = "VISC" Then
Sheets("Active").Cells(w, "J").EntireRow.Copy Destination:=Sheets("Cancelled").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next w
End Sub

 

[mperrah]

When you are scanning through rows to delete it is best to go from bottom to top so the iteration of the row numbering remains as each deleted row gets removed.

Sub deleteRowsTransferred()
Dim x, z as long
dim LastRowB as range

LastRowB = ""
x = ""
z = ""
LastRowB = Sheets("Active").Cells(Rows.Count, 1).End(xlUp).Row

For z = LastRowB to 2 step -1
If Sheets("Active").Cells(z, 10).Value = "VISU" Or Sheets("Active").Cells(z, 10).Value = "VISC" Or Sheets("Active").Cells(z, 10).Value = "CTTV" Or Sheets("Active").Cells(z, 10).Value = "VISS" Then
Sheets("Active").Cells(z, 10).EntireRow.Delete
End If
Next z
LastRowB = Sheets("Active").Cells(Rows.Count, 1).End(xlUp).Row
For w = LastRowB to 2 step -1
If Sheets("Active").Cells(w, 10).Value = "VISC" Then
Sheets("Active").Cells(w, 10).EntireRow.Copy Destination:=Sheets("Cancelled").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next w
End Sub

Also not sure, but "Active" is a property or the Worksheets Object, may lead to problems in coding - might be ok, not tested.
hope this helps.
-mark

 

[mperrah]

after some deeper inspection I came up with this:

Sub MoveCompleteAndDelete()
Dim i, y, lr As Long
Dim wb As Workbook
Dim wsA, wsT, wsL As Worksheet

Set wb = Application.Workbooks(1)
Set wsAct = wb.Worksheets("Active")
Set wsCmpd = wb.Worksheets("Completed")
Set wsCncl = wb.Worksheets("Canceled")

lr = wsAct.Cells(Rows.Count, 1).End(xlUp).Row
    With wsAct
    For i = 2 To lr
        If .Cells(i, 10).Value = "VISU" Or _
            .Cells(i, 10).Value = "CTTV" Or _
            .Cells(i, 10).Value = "VISS" Then
            .Cells(i, 10).EntireRow.Copy _
            Destination:=wsCmpd.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        Else
            If .Cells(i, 10).Value = "VISC" Then
                .Cells(i, 10).EntireRow.Copy _
                Destination:=wsCncl.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End If
        End If
    Next i

'deleteRowsTransferred
    For z = lr To 2 Step -1
            If .Cells(z, 10).Value = "VISU" Or _
               .Cells(z, 10).Value = "VISC" Or _
               .Cells(z, 10).Value = "CTTV" Or _
               .Cells(z, 10).Value = "VISS" Then
               .Cells(z, 10).EntireRow.Delete
            End If
        Next z
    End With
End Sub

If I read your requirements correctly this does what you ask.
Hope it helps
-mark