Avatar of Kailey Lowe
Kailey Lowe
 asked on

Move entire row to another pre-existing workbook based on cell value

I am sorting the status of a job as Loaded / Unloaded based on the text within the cell. What i need is to have a macro button installed which when pressed should read the cell value in  the status column and if it finds "Loaded" in column "S" then move the entire row to a different workbook (lets call it workbook2). Upon the transfer of the row of data it will delete from the current sheet. Workbook2 will have  two sheets for the sorted data - one for loaded and one for unloaded. An important feature of this code is that workbook2 already exists and therefore this macro will just need to open this notebook and save / close once the rows have been transferred.

My intent is to use this macro command button as an archive button to export the data from the current file to the next available row in  workbook2 (a pre-existing workbook).
Microsoft OfficeVBAMicrosoft Excel

Avatar of undefined
Last Comment
Martin Liss

8/22/2022 - Mon
ASKER CERTIFIED SOLUTION
Martin Liss

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Martin Liss

BTW I removed the ' Visual Basic Classic' (VB6) topic since I assumed that you didn't want the solution written in that language. If you do want a VB6 solution let me know and I'll put the topic back and rewrite my solution in that language.
Kailey Lowe

ASKER
Hi Martin! Thanks so much for your work on this. This workbook looks like it's going to work the way I would like it to! In addition to its current operation I would like the rows that have been archived to the new workbook to be removed from the first workbook
Martin Liss

I'm sorry, I forgot about this. I see that you are using Excel on an Apple product. I have no experience with that but I'll see what I can do.
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
Martin Liss

Try this little test program and tell me what happens.
Test.xlsm
Kailey Lowe

ASKER
No worries Martin, I appreciate you getting back to me!
I just altered your first code to add a loop to delete the rows that had been archived:
Here is what I came up with.. it seems to be working well!

Private Sub CommandButton1_Click()

Dim strArchiveWB As Variant
Dim lngNewRow As Long
Dim lngRow As Long
Dim wbArchive As Workbook
Dim wbSource As Workbook
Dim c As Range
Dim FirstAddress As String
Dim lngCount As Long

strArchiveWB = Application.GetOpenFilename(Title:="Please choose a file to import", FileFilter:="Excel Files *.xlsx (*.xlsx),")

If strArchiveWB = False Then
    MsgBox "No file specified.", vbExclamation, "GetShipment"
    Exit Sub
Else
    Application.ScreenUpdating = False
    Set wbSource = ThisWorkbook
    Set wbArchive = Workbooks.Open(strArchiveWB)

    With wbArchive.Sheets("Sheet1")
        If IsEmpty(.Range("A1")) Then
            lngNewRow = 0
        Else
            lngNewRow = .Range("A1048576").End(xlUp).Row
        End If
         
        With wbSource.Sheets("Schedule").Columns("S")
            Set c = .Find("LOADED", LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                FirstAddress = c.Address
                Do
                    lngNewRow = lngNewRow + 1
                    wbSource.Sheets("Schedule").Cells(c.Row, "A").EntireRow.Copy Destination:=wbArchive.Sheets("Sheet1").Cells(lngNewRow, "A")
                    lngCount = lngCount + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> FirstAddress
               
                Application.DisplayAlerts = False
                wbArchive.Close SaveChanges:=True
                Application.DisplayAlerts = True
               
    Last = Cells(Rows.Count, "D").End(xlUp).Row
    For I = Last To 1 Step -1
        If (Cells(I, "S").Value) = "LOADED" Then
            Cells(I, "A").EntireRow.Delete
        End If
    Next I
               
                MsgBox "Archiving complete. " & lngCount & " rows archived."
            End If
        End With
    End With
End If

End Sub
Martin Liss

I’m glad I was able to help.

If you expand the “Full Biography” section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2017
              Experts Exchange Top Expert VBA (current)
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.