Macro to move rows in worksheets not working as expected?

MeghanD

New Member
Joined
Apr 28, 2015
Messages
3
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
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

mperrah

Board Regular
Joined
Mar 12, 2005
Messages
53
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.

Code:
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

Board Regular
Joined
Mar 12, 2005
Messages
53
after some deeper inspection I came up with this:
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,753
Messages
5,524,664
Members
409,597
Latest member
Dannydev

This Week's Hot Topics

Top