CODEWITHSUNDEEP
vbaexcel
Sshitanshu
Sshitanshu

Reputation: 61

Macro to delete specific range of row

I have the below macro that deletes 8 rows of data leaving 1 row 

Sub sbVBS_To_Delete_Rows_In_Range()
Dim iCntr
Dim rng, rng1, rng2, rng3 As Range
Set rng = Range("A9:A16")
Set rng1 = Range("A18:A25")
Set rng2 = Range("A27:A34")
Set rng3 = Range("A36:A43")
    For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
 For iCntr = rng1.Row + rng1.Rows.Count - 1 To rng1.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
     For iCntr = rng2.Row + rng2.Rows.Count - 1 To rng2.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
     For iCntr = rng3.Row + rng3.Rows.Count - 1 To rng3.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next
End Sub

is there any way I can modify this so that I don't have to manually specify range i.e a macro to delete 8 rows skipping 1 row then again deleting 8 rows skipping 1 row

Upvotes: 0

Views: 730

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

I suggest the following:

Option Explicit

Public Sub Delete8RowsSkip1()
    Dim RangeToDelete As Range

    Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    For iRow = 9 To LastRow Step 9 'run from row 9 to last row in steps of 9
        If RangeToDelete Is Nothing Then 'first range
            Set RangeToDelete = Rows(iRow).Resize(RowSize:=8) 'collect first 8 rows to delete
        Else 'further ranges
            Set RangeToDelete = Union(RangeToDelete, Rows(iRow).Resize(RowSize:=8)) 'collect next 8 rows to delete
        End If
    Next iRow

    RangeToDelete.Delete 'delete all collected rows
End Sub

First we find the last used row in column A, so this is the end for our For loop. The loop makes 9 steps at once and then collects the next 8 rows and adds them to RangeToDelete. In the end we delete all collected rows at once (which is very fast compared to deleting each row by row).

Note that running the loop backwards is not needed here, because we delete all rows at once in the end which doesn't change the row counting like as when we delete row by row.

Edit

The following example takes into account what @ComradeMicha mentioned in his comment. This will match the deleted rows to LastRow. This might be needed if other columns than column A have more data rows than column A.

Option Explicit

Public Sub Delete8RowsSkip1()
    Dim RangeToDelete As Range

    Dim LastRow As Long
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row

    Dim DeleteRows As Long
    DeleteRows = 8

    Dim iRow As Long
    For iRow = 9 To LastRow Step 9
        If iRow + DeleteRows - 1 > LastRow Then DeleteRows = LastRow - iRow + 1

        If RangeToDelete Is Nothing Then
            Set RangeToDelete = Rows(iRow).Resize(RowSize:=DeleteRows)
        Else
            Set RangeToDelete = Union(RangeToDelete, Rows(iRow).Resize(RowSize:=DeleteRows))
        End If
    Next iRow

    RangeToDelete.Delete
End Sub

Upvotes: 2

Related Questions