We help IT Professionals succeed at work.

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

86 Views
1 Endorsement
Last Modified: 2018-09-26
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

Social distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
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
Martin LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
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 LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
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 LissSocial distance - Don't touch your face - Wash your hands for 20 seconds
CERTIFIED EXPERT
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)
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.