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

Kailey Lowe
Kailey Lowe used Ask the Experts™
on
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).
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
I've attached two workbooks. When you click the 'Archive' button in the 29118725 workbook, Workbook2 will be updated in the background.
29118725.xlsm
Workbook2.xlsx
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.

Author

Commented:
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
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Try this little test program and tell me what happens.
Test.xlsm

Author

Commented:
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 LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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)

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial