Delete blank row from Recordset

Question

I have a sheet with a drop down list that outputs data based on that selection. At most it's 3 rows but sometimes 1 or 2 rows, at the moment it always outputs 3 rows even if they are empty and I want to check if the rows are null and delete. Please find the code below, I have added pictures too to give a better understanding. Also the Add_Total() sub routine doesn't output the total to the correct rows when the recordset contains less then 3 rows?

Private Sub dateBox_Change()


        Dim connection As New ADODB.connection, dttime1, dttime2, dttime3

        connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
        ";Extended Properties=""Excel 12.0;HDR=YES;"";"

        Dim dateQuery As String
        Dim queryString As String
        Dim cptString1 As String
        Dim cptString2 As String
        Dim cptString3 As String
        Dim date1 As String
        Dim date2 As String
        Dim date3 As String
        Dim datetime1 As Date
        Dim datetime2 As Date
        Dim datetime3 As Date 

        dateQuery = Me.dateBox.Text

        cptString1 = "00:30"
        cptString2 = "01:30"
        cptString3 = "02:00"
        
        
        date1 = dateQuery
        date2 = dateQuery
        date3 = dateQuery
        
        datetime1 = (DateValue(date1) + TimeValue(cptString1))
        datetime2 = (DateValue(date2) + TimeValue(cptString2))
        datetime3 = (DateValue(date3) + TimeValue(cptString3))
        
        dttime1 = 1 * (datetime1)
        dttime2 = 1 * (datetime2)
        dttime3 = 1 * (datetime3)


        queryString = "Select [Lane],[Containerized Packages],[Staged Packages],[Loaded Packages],[Staged Packages]+[Containerized Packages]+[Loaded Packages]  as TotalProcessed,[Departed Packages]," & _
        "[Expected Packages],[All Packages],[Expected Packages] + [All Packages] - [TotalProcessed] as Remaining,[Departed Packages] + [Expected Packages] + [All Packages] as TotalVolume from [Data$] where [CPTs]*1 =" & dttime1 & "or [CPTs] *1 =" & dttime2 & "or [CPTs] *1 =" & dttime3
         
        
        
        Dim rs As New ADODB.Recordset
        rs.Open queryString, connection
        


        Dim rSht As Worksheet
        Set rSht = ThisWorkbook.Worksheets("Sheet1")

        With rSht

        .Cells.ClearContents
        For i = 0 To rs.Fields.Count - 1
        .Cells(4, i + 1).Value = rs.Fields(i).Name
        Next i
        .Range("A5").CopyFromRecordset rs

        End With
        
        Call Add_Total

        connection.Close
End Sub


Public Sub Add_Total()

    Dim ColumnNumber As Long
    Dim LastRow As Long

    With ThisWorkbook.Worksheets("Sheet1")
        For ColumnNumber = 5 To 10
            LastRow = .Cells(.Rows.Count, ColumnNumber).End(xlUp).Row
            With .Cells(LastRow + 1, ColumnNumber)
                .FormulaR1C1 = "=SUM(R2C:R[-1]C)"
            End With
        Next ColumnNumber
    End With

End Sub

Answer 1

I believe that the .Cells.ClearContents statement is clearing the data, but is not actually deleting the rows. If your were to check the value of .Range("A" & .Rows.Count).End(xlUp).Row immediately afterwards, you would see the same number of rows that the prior data occupied.

If the rows populated by .Range("A5").CopyFromRecordset rs is fewer than the prior data, those extra rows still remain, even if they are blank.

You need to actually delete the old rows, not just clear them. Try either of the following:

.Cells.Delete
.Rows.Delete