Cutting and pasting data based on a criteria

[LesKing]

Hi,

I have a workbook which has two (relevant) worksheets in it: “Database” and “Archived Records”.

In column H of the “Database” worksheet (headed ‘Job Status’ – with data starting at row 3 – allowing for headers in rows 1 and 2) are the words “Current” or “Archived” within each row of data.

What I need is a macro that will cut any rows of data which have “Archived” recorded in column H and paste those rows into the next available rows in the “Archived Records” worksheet. I then need to ensure the cut rows (in the “Database” worksheet) have all been deleted and the remaining rows moved up as necessary. I then need the macro to finish by opening the “Archived Records” worksheet with the active cell being the top left cell.

I have tried the following, but it doesn’t quite work:

Sub MoveArchivedRecords()

a = Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If Worksheets("Database").Cells(i, 8).Value = "Archived" Then

    Worksheets("Database").Rows(i).Cut

    Worksheets("Archived Records").Activate

    b = Worksheets("Archived Records").Cells(Rows.Count, 1).End(xlUp).Row

    Worksheets("Archived Records").Cells(b + 1, 1).Select

    ActiveSheet.Paste

    Worksheets("Database").Activate

End If

Next

For i = 2 To a

If Worksheets("Database").Cells(i, 1).Value = "" Then

Rows(i).Delete

End If

Next

Worksheets("Archived Records").Activate

End Sub

I cannot see where the problem is with this macro. Can anyone tell me a better way to do this that fully works, please. 

Thank you.

[#2]

@LesKing 

Your current macro is on the right track, but there are a few adjustments needed to make it work correctly. Here is a revised version of your macro:

Vba code is untested, please backup your file.

Sub MoveArchivedRecords()
    Dim wsDatabase As Worksheet
    Dim wsArchived As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    
    ' Set references to the Database and Archived Records worksheets
    Set wsDatabase = ThisWorkbook.Worksheets("Database")
    Set wsArchived = ThisWorkbook.Worksheets("Archived Records")
    
    ' Find the last row with data in column H of the Database worksheet
    lastRow = wsDatabase.Cells(wsDatabase.Rows.Count, "H").End(xlUp).Row
    
    ' Loop through each row in column H of the Database worksheet
    For i = lastRow To 3 Step -1 ' Start from the last row and loop backwards to avoid issues with row deletion
        
        ' Check if the value in column H is "Archived"
        If wsDatabase.Cells(i, "H").Value = "Archived" Then
            ' Find the next available row in the Archived Records worksheet
            j = wsArchived.Cells(wsArchived.Rows.Count, 1).End(xlUp).Row + 1
            
            ' Cut the entire row from the Database worksheet and paste it into the Archived Records worksheet
            wsDatabase.Rows(i).Cut Destination:=wsArchived.Rows(j)
            
            ' Delete the row from the Database worksheet
            wsDatabase.Rows(i).Delete
        End If
    Next i
    
    ' Activate the Archived Records worksheet and select the top-left cell
    wsArchived.Activate
    wsArchived.Cells(1, 1).Select
End Sub

Here's a breakdown of the changes and improvements made:

1. Declared variables to store references to the Database and Archived Records worksheets, as well as other variables used in the macro.
2. Used Set keyword to assign worksheet references.
3. Reversed the loop to start from the last row and loop backwards to avoid issues with row deletion.
4. Used explicit references to columns in the cells and rows manipulation to ensure clarity and avoid potential errors.
5. Updated the loop to correctly find the next available row in the Archived Records worksheet.
6. Corrected the syntax for cutting and pasting rows.
7. Activated the Archived Records worksheet and selected the top-left cell at the end of the macro.

These adjustments should resolve the issues you were facing with your macro. The text, steps and the code were created with the help of AI.

My answers are voluntary and without guarantee!

Hope this will help you.

Was the answer useful? Mark as best response and like it!

This will help all forum participants.

[#3]

Hi Nikolino,
Your code worked perfectly and achieved exactly what I wanted!
Thanks for the additional explanatory bits - you are an excellent tutor.
Can't fathom how you can use AI to create the code - but can't fault it!!
Thank you so much.
Les King