Forum Discussion

LesKing's avatar
LesKing
Brass Contributor
Apr 03, 2024

Cutting and pasting data based on a criteria

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.

  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    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.

    • LesKing's avatar
      LesKing
      Brass Contributor
      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

Resources