Why is my excel VBA Macro run successfully one time and then crash and close the workbook with no error message the second time?

Question

I have two excel tables on two different sheets: "Open" and "Hold or Closed".

On the "Open" sheet, I am trying to cut a row inside the table and paste it into the "Hold or Closed" Table if the "CLOSED_DATE" column record is populated. If not populated, nothing happens.

My code is successful on the first iteration, but if I run it again, I get the spinning wheel of death, which leads to my workbook closing without an error message on the second iteration.

Here is my code, maybe there's an infinite loop somewhere.

Sub CutPasteRows()
    Dim sourceTable As ListObject
    Dim newTable As ListObject
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim Count As Integer
    Dim i As Long
    Dim ii As Long

    Set sourceTable = Worksheets("Open").ListObjects("Current_Ops_TBL8")
    Set newTable = Worksheets("Hold or Closed").ListObjects("Hold_Closed_TBL3")
    Set targetTable = Worksheets("Hold or Closed")
    Count = 4
    ii = sourceTable.Range.Rows.Count
    
    Debug.Print (sourceTable.ListColumns("IAA CLOSED DATE").DataBodyRange.Rows.Count())
    
    
    For Each iListRow In sourceTable.ListColumns("IAA CLOSED DATE").DataBodyRange.Rows
        Debug.Print (iListRow)
        If iListRow.Value <> "" Then
            Debug.Print (iListRow.Value)
            Worksheets("Open").Rows(Count).Copy
            targetTable.Rows("2").Insert
            Worksheets("Open").Rows(Count).Clear
        End If
        Count = Count + 1
    Next iListRow

End Sub

I expect every time I insert a date in the "CLOSED_DATE" column and select run macro, the "Open" sheet row gets pasted in the "Hold or Closed" sheet. The "Open" sheet row will become blank.

If someone can teach me some VBA here that would be splendid.

Thank you in advance.

Answer 1

Export Data: Move Excel Table Rows To Another Excel Table

Before

After

Sub ExportClosedData()
    ' Write the title of the procedure to a constant variable to be used
    ' as the title of all message boxes that may be displayed to the user,
    ' to make it easy to identify which procedure the message box is related to.
    Const PROC_TITLE As String = "Export Closed Data"
    
    ' Turn off screen updating to speed up the code execution.
    Application.ScreenUpdating = False
        
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Source: Reference the Range
    
    ' Reference the source worksheet and table.
    Dim sws As Worksheet: Set sws = wb.Sheets("Open")
    Dim slo As ListObject: Set slo = sws.ListObjects("Current_Ops_TBL8")
    
    ' Clear active filters.
    With slo
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
    End With
    
    ' Reference the source range (no headers).
    Dim srg As Range: Set srg = slo.DataBodyRange

    ' Check if there is any data in the source table, and if there is none,
    ' display an error message and exit.
    If srg Is Nothing Then
        MsgBox "No data in the source table.", vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    ' Store the column index of the criteria column in a variable.
    Dim sCol As Long: sCol = slo.ListColumns("IAA CLOSED DATE").Index
    
    ' Destination: Reference the First Row Range
    
    ' Reference the destination worksheet and table.
    Dim dws As Worksheet: Set dws = wb.Sheets("Hold or Closed")
    Dim dlo As ListObject: Set dlo = dws.ListObjects("Hold_Closed_TBL3")
    
    ' Clear active filters.
    With dlo
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
    End With
    
    ' Attempt to reference the destination table's data range.
    Dim drg As Range: Set drg = dlo.DataBodyRange
    
    ' Reference the first destination data row.
    If drg Is Nothing Then dlo.ListRows.Add ' no data in table
    Set drg = dlo.DataBodyRange.Rows(1)
   
    ' Copy, insert and paste, and combine to finally delete.
    
    Dim surg As Range, srrg As Range, rCount As Long
    
    ' For each row in the source table...
    For Each srrg In srg.Rows
        ' ... check if the value in the criteria column is not blank.
        If Len(CStr(srrg.Cells(sCol).Value)) > 0 Then ' is not blank
            ' Insert a new row in the destination table.
            drg.Insert xlShiftDown, xlFormatFromLeftOrAbove
            ' Correct the destination row.
            Set drg = drg.Offset(-1)
            ' Copy the data from the source row to the destination row.
            srrg.Copy drg
            ' Combine the source row into a unioned range.
            If surg Is Nothing Then
                Set surg = srrg
            Else
                Set surg = Union(surg, srrg)
            End If
            ' Increment the counter used to display the final count
            ' in a message box.
            rCount = rCount + 1
        'Else ' the value is blank; do nothing
        End If
    Next srrg
    
    ' Delete the source rows in one go, if any.
    If rCount > 0 Then surg.Delete xlShiftUp
    
    ' Turn screen updating back on.
    Application.ScreenUpdating = True
    
    ' Inform.
    
    ' Display a message indicating how many rows of 'closed' data were exported,
    ' or a warning message if there is no 'closed' data to export.
    If rCount > 0 Then
        MsgBox rCount & " record" & IIf(rCount = 1, "", "s") _
            & " of closed data exported.", vbInformation, PROC_TITLE
    Else
        MsgBox "No closed data. Nothing to export.", vbExclamation, PROC_TITLE
    End If

End Sub