Delete range based on cell values

[palinkas]

Hi,

I've tried to put together a macro based on what I have found here in other threads but got stuck and to be honest, I'm not even sure my approach is correct to the problem, as I'm new to VBA.

In my sheet, there are several 'blocks' of data under each other and they all follow the same structure: first there is a header that states the type of data (e.g. "Growth", "Will Dos", "Risk") then there are rows of data of that type, then comes the next header and so on. These blocks are repeated several times and the number of them changes from time to time. All the headers are in Row A and data starts in A2.

What I need is to select all the rows that are between the "Will Dos" and "In-Year Growth" headers and delete them. I could make my macro work for one of these ranges but I can't figure out how to delete all the ranges that meet this criteria.

This is what I've done so far and I'm sure there are many mistakes.

Sheets("Data").Select
Dim WillDo As Long
Dim Growth As Long
Dim nStart As Long, nEnd As Long
        
For WillDo = 1 To 65536
    If Range("A" & WillDo).Value = "Will Dos" Then
    nStart = WillDo
    End If
    For Growth = nStart To 65536
        If Range("A" & Growth).Value = "In-Year Growth" Then
        nEnd = Growth
        End If
    nEnd = nEnd - 1
    Range("A" & nStart & ":CS" & nEnd).Select
    Selection.Delete Shift:=xlUp
    Next Growth
Next WillDo

Any kind of help is appreciated and if my explanation doesn't make sense (English is not my first language), I can try to describe the problem better.

 

[mumps]

Try:

Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim counter As Long, x As Long
    counter = WorksheetFunction.CountIf(Sheets("Data").Range("A:A"), "Will Dos")
    Dim foundVal1 As Range, foundVal2 As Range
    For x = 1 To counter
        Set foundVal1 = Sheets("Data").Range("A:A").Find("Will Dos")
        Set foundVal2 = Sheets("Data").Range("A:A").SpecialCells(xlCellTypeVisible).Find("In-Year Growth")
        Rows(foundVal2.Row).Hidden = True
        Range("A" & foundVal1.Row & ":A" & foundVal2.Row - 1).EntireRow.Delete
    Next x
    Sheets("Data").Cells.Rows.Hidden = False
    Application.ScreenUpdating = True
End Sub

 

[palinkas]

It works perfectly, thanks so much

 

[mumps]

You are very welcome.