如何删除范围内的所有行？

Question

I'm new to vba, and I've written the code below but can't figure out why it's not working.

Sub DataValidationDeleteWrongOrigin()
'
'Description: Goes through and deletes rows that are called out on the delete entry column.
'


'Dimension Worksheet
Dim DataValWs As Worksheet
Set DataValWs = Worksheets("Data Validation")

'Find the size of the table and store it as LastDataRow
Dim LastDataRow As Long
LastDataRow = DataValWs.Range("A5").End(xlDown).Row


'ThisRow will be the current row as the for loop goes through each row.
Dim ThisRow As Long
Dim DeleteRange As Range
Dim CurrentRow As Range
'Start the for loop from row 5
For ThisRow = 5 To LastDataRow

    'Check the Delete Entry row to see if it says Yes, delete the row. Use DeleteRange to add cells to it and delete them all at the end (much _
    faster than deleting them one at a time, and you don't have to re-find the size of the table after each row is deleted).

    If Cells(ThisRow, 16) = "Yes" Then
        If Not DeleteRange Is Nothing Then
            Set CurrentRow = DataValWs.Rows(ThisRow)
            Set DeleteRange = Union(CurrentRow, DeleteRange)
        Else
            Set DeleteRange = DataValWs.Cells(ThisRow, 16)
        End If


    End If

Next ThisRow

'DeleteRange.Select
DeleteRange.EntireRow.Delete



End Sub

Currently, the code gives me

Run-time error 1004 : Delete method of Range class failed.

The "DeleteRange.Select" that is commented out near the end of the code selects the correct range, so I know the range is being built accurately.

I want to be able to just drop all of the rows to be deleted off of the sheet at once --the number of rows to be deleted could get pretty high in this application, and I'd prefer it not take forever to run.

I've looked around online, and found a couple of solutions that involve going through the DeleteRange iteratively and deleting each row out of it, but that gives me the same problem of deleting rows one at a time. Is there a better way to handle this? Or, better yet, have I messed up in defining the DeleteRange?

Thank you!

Edit:

Did some testing with different sets of rows, and it turns out it has no problem deleting the rows if they're all adjacent to each other. Only results in the run time error if the rows have gaps between them...

Answer 1

将“EntireRow”属性添加到该行，如下所示：

Set DeleteRange = DataValWs.Cells(ThisRow, 16).EntireRow

Answer 2

I could replicate your problem only when there was an object at the side of the range (ie a ListObject )

Check the data in your worksheet and if that is the case use rDelete.Delete Shift:=xlUp

Assuming your DATA is located in the range A5:P# (where # is the last row of data) use this code.

Sub Delete_Rows()
Dim ws As Worksheet
Dim rDelete As Range
Dim rData As Range, rRow As Range, lRw As Long

    Set ws = Worksheets("Data Validation")
    With ws
        lRw = .Range("A5").End(xlDown).Row
        Set rData = Range(.Range("A5"), Range("P" & lRw))    'adjust as required
    End With

    For Each rRow In rData.Rows
        If rRow.Cells(16) = "Yes" Then
            If rDelete Is Nothing Then
                Set rDelete = rRow

            Else
                Set rDelete = Union(rDelete, rRow)

    End If: End If: Next

    rDelete.Delete Shift:=xlUp

    End Sub