0

I'm stuck trying to delete a row in a table after copying and pasting it to another Workbook table. It worked when I was activating workbooks and sheets but now has stopped. Can this be done the way I have the code now? Any help is greatly appreciated. I have been trying to fix this for two days now..

Sub MoveOrdertoDelivery()
'
' Move_Order Macro
' Move the next line on the Delivery Log for the day
'
'*************************************************************************
' New Code for MoveLinetoDeliverySchedule
'*************************************************************************

    Dim copyrng As Range
    Dim rngOld As Range
    Dim msgRes As VbMsgBoxResult
    Dim checkcellrange As Range
    Dim strFileDir As String
    ' new to use the better code****DELETE AFTER IT WORKS
    Dim destinationSheetName As String
    Dim originatingWorkbookName As String
    Dim originatingWorkbook As Workbook
    Dim destinationWorkbook As Workbook
    Dim originatingSheetName As String
    Dim destinationFileName As String
    Dim originatingTableName As String
    Dim destinationTableName As String
        
    strFileDir = ThisWorkbook.Path
    originatingWorkbookName = ActiveWorkbook.Name
    originatingSheetName = ActiveSheet.Name
    destinationFileName = strFileDir & "\Door Delivery Schedule.xlsm"
    Set checkcellrange = Range("A1:ZZ3")
    Set rngOld = ActiveCell
    Set originatingWorkbook = Workbooks.Open(strFileDir & "\" & originatingWorkbookName)
    ActiveSheet.Cells(ActiveCell.Row, 1).Select
    Set copyrng = Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 11))
    copyrng.Select
    
    
    If Intersect(checkcellrange, copyrng) Is Nothing Then
        originatingTableName = ActiveCell.ListObject.Name
        Else
        msgRes = MsgBox("Please select a table Row!", vbOKCancel)
        Exit Sub
    End If
    
    
    
    If Intersect(checkcellrange, rngOld) Is Nothing Then
        
                If Not allBlank(ThisWorkbook.Sheets(originatingSheetName).Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 11))) Then
                msgRes = MsgBox("Proceed?", vbOKCancel, "You are about to Move this row to the Door Delivery Schedule.")
                    
                    If msgRes = vbOK Then
                    Selection.Copy
                        On Error Resume Next
                        tablerow = Selection.Row - Selection.ListObject.Range.Row
                        
                        If Err.Number = 91 Then
                        MsgBox "Please select a line with data in it!"
                        Exit Sub
                        End If
                        'originatingWorkbook.Sheets(originatingSheetName).Range(ListObjects(originatingTableName).ListRows(tablerow)).Copy
                        'originatingWorkbook.Sheets(originatingSheetName).Range(copyrng).Copy
                        Set destinationWorkbook = Workbooks.Open(destinationFileName)
                        destinationWorkbook.Sheets("Orders For Delivery").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
                        destinationWorkbook.Save
                        destinationWorkbook.Close
                        'originatingWorkbook.Sheets(originatingSheetName).Selection.Delete Shift:=
                        Windows("Production Schedule Main.xlsm").Activate
                        Sheets("Completed Orders").Activate
                        copyrng.Select
                        originatingWorkbook.Sheets(originatingSheetName).Selection.ListObject.ListRows(tablerow).Delete
                        Selection.Delete Shift:=x1Up
            
                        Exit Sub
                    Else
                    
                    
                    End If
    
                
        
                Else
                    MsgBox ("Please select a row with data in it.")
                End If
    Else
        MsgBox ("Please select a legal row in the field.")
    End If

End Sub
Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45
Mark P
  • 1
  • 1
  • This is not JQuery Datatables. Did you mean Excel? Please update your tags, otherwise the people you are aiming your question at won't be able to see it. – mark_b Apr 19 '22 at 12:11
  • How has it stopped working? Do you get a message? If not the `On Error Resume Next` line is probably hiding it. – Darren Bartrup-Cook Apr 19 '22 at 14:22
  • It doesn't delete the row. It does get selected on selection command but not deleted.. – Mark P Apr 19 '22 at 16:24
  • I figured it out finally. I had to separate these in the code line: originatingWorkbook.Sheets(originatingSheetName).Selection.ListObject.ListRows(tablerow).Delete And use this instead Selection.ListObject.ListRows(tablerow).Delete – Mark P Apr 19 '22 at 16:44
  • Didn't see that bit. I'd suggest having a look at this link: [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – Darren Bartrup-Cook Apr 20 '22 at 13:31
  • That's why I was changing my code. But come to find out, there are times you can't get around it.. – Mark P Apr 21 '22 at 22:21

0 Answers0