delete multiple row based on criteria

**miso.dca** · 12-15-2009, 12:46 PM

hello,
I need help with one issue (I uploaded excel worksheet with data) and I need this :
if in column A in some row is text "today" then delete this row and delete all rows until in row B wont be empty cell

I have start (If in A is "Today" then ... ) but thas's all

Sub delete()
Dim lngRow As Long
    lngRow = 1
    For lngRow = 1 To 24
    If Range("A" & lngRow) = "Today" Then

    
    End If
    Next    
End Sub

anyone who could help? THANKS !

**Palmetto** · 12-15-2009, 01:13 PM

As long as your pattern is consistent ("Today" with two rows inbetween), this should work. If you actual workbook is different or the patter varies then this will not work fully.

Option Explicit

Sub delete_rows()

    Dim c As Range, lrow As Long
    
    lrow = Cells(Rows.Count, 2).End(xlUp).Row
    
    For Each c In Range("A1:A" & lrow)
        If c.Value = "Today" Then c.EntireRow.Resize(3).Delete
    Next c

End Sub

**MickG** · 12-15-2009, 02:06 PM

Hi, Try this:-

Sub MG15Dec11
Dim Rng As Range, n As Long, R As Range
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
For n = Rng.Count To 1 Step -1
    With Range("A" & n)
        If .Value = "Today" Then
             Set R = Range(.Address & ":" & .Offset(, 1).End(xlDown).Offset(-1).Address)
              R.EntireRow.Delete
         End If
    End With
Next n
End Sub

Regards Mick

**miso.dca** · 12-15-2009, 04:07 PM

Palmetto - tahnks, yes, your solution works but unfortunatelly pattern is different, it isnt always just 2 rows ... (for two rows it isnt very difficult, I'd make it by myself)
MickG - sorry, but your solution deleted only row where was text "today" I need to delete whole yelllow area, but thanks !

(or do I do anything wrong?

)

**Palmetto** · 12-15-2009, 05:30 PM

OK. This works during testing for any pattern. It fills the "inbetween rows" with the word "Today" then just loops through to delete all cells with the word.
See attached.

Option Explicit

Sub delete_rows()

    Dim c As Range, lrow As Long, i As Long
    
    lrow = Cells(Rows.Count, 2).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    For Each c In Range("A1:A" & lrow)
        If c.Value = "Today" And c.Offset(1, 0).Value = vbNullString Then
            c.Offset(1, 0).Value = "Today"
        End If
    Next c
    
    For i = lrow To 1 Step -1
        For Each c In Range("A1:A" & lrow)
                If c.Value = "Today" Then c.EntireRow.Delete
        Next c
    Next i

    Application.ScreenUpdating = True

End Sub