CODEWITHSUNDEEP
excelvbaexcel-formula
lemonbars
lemonbars

Reputation: 13

How to delete five rows after every sixth row?

I need to delete 5 rows after every 6th row, assuming the first row is the first which is ignored. For example:

Row 1 <-- want to keep
Row 2-6 <-- want to delete
Row 7 <-- want to keep
Row 8-12 <-- want to delete
etc., for all rows with values in column A

I tried manually removing the unneeded rows, but realized there must be a better way. I did look up several VBA examples that delete every other row, but I need to delete a range of rows every so many, and am uncertain how to handle that. I am also uncertain how to modify the code to keep looping for all rows that have data in column A, not just a specific set.

Sub sbVBS_To_Delete_Rows_In_Range()
Dim iCntr
Dim rng As Range
Set rng = Range("A10:D20")

    For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1
       Rows(iCntr).EntireRow.Delete
    Next

End Sub

This appears to delete one range of rows, so that's closer than I've been before. However, I need to keep going for all rows that contain date in Column A.

Upvotes: 0

Views: 291

Answers (2)

tigeravatar
tigeravatar

Reputation: 26670

I believe something like this is what you're looking for:

Sub tgr()

    Dim ws As Worksheet
    Dim rStart As Range
    Dim rStop As Range
    Dim rTemp As Range
    Dim rDel As Range
    Dim lGroupSize As Long
    Dim i As Long

    Set ws = ActiveWorkbook.ActiveSheet
    Set rStart = ws.Columns("A").Find("*", ws.Cells(ws.Rows.Count, "A"), xlValues, xlPart)
    Set rStop = ws.Cells(ws.Rows.Count, "A").End(xlUp)
    lGroupSize = 5

    For i = rStart.Row To rStop.Row Step lGroupSize + 1
        Set rTemp = ws.Cells(i + 1, "A").Resize(lGroupSize)
        If rDel Is Nothing Then Set rDel = rTemp Else Set rDel = Union(rDel, rTemp)
    Next i

    If Not rDel Is Nothing Then rDel.EntireRow.Delete

End Sub

EDIT: Updated code, per request in the comments

Sub tgr()

    Dim ws As Worksheet
    Dim rStart As Range
    Dim rStop As Range
    Dim rTemp As Range
    Dim rDel As Range
    Dim sColCheck As String
    Dim lGroupSize As Long
    Dim i As Long, j As Long

    Set ws = ActiveWorkbook.ActiveSheet
    sColCheck = "A"
    lGroupSize = 5

    Set rStart = ws.Columns(sColCheck).Find("*", ws.Cells(ws.Rows.Count, sColCheck), xlValues, xlPart)
    Set rStop = ws.Cells(ws.Rows.Count, sColCheck).End(xlUp)

    i = rStart.Row
    Do While i <= rStop.Row
        Set rTemp = Nothing
        For j = 1 To lGroupSize
            If IsDate(ws.Cells(i + j, sColCheck)) Then
                Set rTemp = ws.Cells(i + 1, sColCheck).Resize(j)
                Exit For
            End If
        Next j
        If Not rTemp Is Nothing Then If rDel Is Nothing Then Set rDel = rTemp Else Set rDel = Union(rDel, rTemp)
        i = i + j + 1
    Loop

    If Not rDel Is Nothing Then rDel.EntireRow.Delete

End Sub

Upvotes: 1

Ronan Vico
Ronan Vico

Reputation: 605

I hope that can works for you , U can pass any range do you want and the frequency!

Sub sbVBS_To_Delete_Rows_In_Range(rg As Range, Optional frequency As Long = 5)
    Dim i As Long
    Dim rangeToDelete As String

    Dim cont As Long
    rangeToDelete = VBA.Split(rg.Cells(i, 1).Address, "$")(1) & (VBA.Split(rg.Cells(i, 1).Address, "$")(2) + 1) & ":" & VBA.Split(rg.Cells(i, 1).Address, "$")(1) & (VBA.Split(rg.Cells(i + frequency, 1).Address, "$")(2))
    For i = 1 To rg.Cells.count
        Range(rangeToDelete).Offset(i - 1).Select
        Range(rangeToDelete).Offset(i - 1).rows.Delete
    Next

End Sub

Upvotes: 0

Related Questions