Start deleting rows on specific name and stop on specific name

Question

I Wanted to rewrite the recent code that clears the content of the rows in specific ranges. The idea is to clear the rows in the ranges when ID starts with the first determined ID in the above legend and it should stop deleting the next rows only if the next ID is the 2nd determined ID in the legend . I have 2 conditions like that when the code should start deleteing and 2 when it should stop.

For better explanation, please, see the screenshots below:

This is situation before running the code:

And this is The Outcome I would like to get:

I have the code from another question that is good but it deletes only the IDs indicated in the legend. How can I incorporate mentioned conditions ?

Option Explicit
    Public Sub ClearCells()
Const COLUMN_START1 As Long = 2
Const COLUMN_END1 As Long = 4
Const COLUMN_START2 As Long = 7
Const COLUMN_END2 As Long = 9
Const START_ROW As Long = 8

Dim loopRanges()

loopRanges = Array(COLUMN_START1, COLUMN_END1, COLUMN_START2, COLUMN_END2)

Dim targetSheet As Worksheet, index As Long, unionRng As Range
Dim id As Long
Set targetSheet = ThisWorkbook.Sheets("Sheet1")
Dim ids(), i As Long
ids = targetSheet.Range("D2:D5").Value

Application.ScreenUpdating = False

With targetSheet

    For i = LBound(ids, 1) To UBound(ids, 1)

    For index = LBound(loopRanges) To UBound(loopRanges) Step 2

        Dim lngLastRow As Long, ClearRange As Range, rng As Range

        lngLastRow = .Cells(.Rows.Count, loopRanges(index)).End(xlUp).Row '
        If lngLastRow < START_ROW Then lngLastRow = START_ROW

        Set ClearRange = .Range(.Cells(START_ROW, loopRanges(index)), .Cells(lngLastRow, loopRanges(index + 1)))

        For Each rng In ClearRange.Columns(1).Cells
            If Not IsEmpty(rng) Then
                If Left$(rng.Value, Len(ids(i, 1))) = ids(i, 1) Then '<== match found
                    If Not unionRng Is Nothing Then
                        Set unionRng = Union(unionRng, rng.Resize(1, ClearRange.Columns.Count)) '<== gather all matches into a union range

                    Else
                        Set unionRng = rng.Resize(1, ClearRange.Columns.Count)
                    End If
                End If
            End If
        Next rng
    Next index

    Next i

    End With

    If Not unionRng Is Nothing Then unionRng.ClearContents     Application.ScreenUpdating = True
MsgBox "Done", vbInformation

    End Sub

You are the second person on StackOverflow today, who goes to the `IsEmpty()` trap - check this - https://stackoverflow.com/questions/51022168/vba-nested-for-loops-not-working/51022254#51022254 — Vityata, Jun 25 '18 at 13:17
This is actually fine. I am looking for a way how to extend/modify the code to make it start deleting when row starts with the term in the legend and continue until it meets the next term in the legend as for stop — Dozens, Jul 22 '18 at 16:30

Start deleting rows on specific name and stop on specific name

0 Answers0