VBA: Moving and deleting Excel rows to other worksheet based on cell value

Question

I'm currently creating a worksheets which moves rows in Excel that contain a cell containing the text "Voltooid" to a second worksheet. I want to either move the rows, or copy+paste and delete them, based on cell value.

Up until now, I've been able to build a function that deletes rows in the table. Please see the code below:

Sub DeleteCompleted()
Dim Test1 As ListObject
Dim Test2 As Variant
Dim Rowcount As Integer

Set Test1 = Sheets("To Do Lijst").ListObjects("Table2")
Test2 = Test1.ListRows.Count

For Rowcount = 1 To Test2 Step 1
    If Test1.DataBodyRange(Rowcount, 4) = "Voltooid" Then
    Test1.DataBodyRange(Rowcount, 4).Delete Shift:=xlUp
    Rowcount = 0
    End If
Next Rowcount

Can you suggest a better format for me?

Kind regards,

Pim

A few comments. When removing elements from a list, of any sort, you should work top to bottom, otherwise you risk missing items. To do so append Step -1 to your Forstatement. Also setting rRowcount = 0 within your For loop will likely cause problems. — Luuklag

Pᴇʜ Pᴇʜ · Accepted Answer · 2018-09-11T11:08:54

Using descriptive variable names makes your life easier
Always use Long for row counting variables, Excel has more rows than Integer can handle. Also never use Variant unless you really have to.
If you delete/add rows you must loop backwards, because deleting/adding changes the row count.
To move a row use Range().Cut and define a destination, eg next free row in another worksheet.

So you end up with something like …

Sub DeleteCompleted()
    Dim ToDoList As ListObject
    Dim ListRowCount As Long
    Dim iRow As Long

    Set ToDoList = Sheets("To Do Lijst").ListObjects("Table2")
    ListRowCount = ToDoList.ListRows.Count

    Dim NextFreeRow As Range

    For iRow = ListRowCount To 1 Step -1
        With ToDoList
            If .DataBodyRange(iRow, 4).Value = "Voltooid" Then
                Set NextFreeRow = Worksheets("Destination").Cells(Rows.Count, 4).End(xlUp).Offset(1, -3)
                ToDoList.ListRows(iRow).Range.Copy Destination:=NextFreeRow
                ToDoList.ListRows(iRow).Range.Delete Shift:=xlUp
            End If
        End With
    Next iRow
End Sub

VBA: Moving and deleting Excel rows to other worksheet based on cell value

1 Answers