Macro to delete all rows except .

[Sunline]

Hello all , i was wanting to get a basic macro that can delete all rows using col O except when Mdn is mentioned .
Also leave row 1 as heading , dont delete row 1 .
Thanks .

 

[marreco]

Good night!!

See if exemple can help you.

Sub DeletRows()

FinalRow = Range("A65536").End(xlUp).Row
i = 2

Do While i <= FinalRow
If Cells(i, 1) <> "Mdn" Or Cells(i, 1) = "" Then
Cells(i, 1).EntireRow.Delete
FinalRow = FinalRow - 1
Else
i = i + 1
End If
Loop

End Sub

 

[Nalani]

Assuming that Column O will be the column that holds the last row of data: If any other Column, then adjustments will have to be made.

Sub test()
    Dim LR As Long
    Application.ScreenUpdating = False
    LR = ActiveSheet.Range("O" & Rows.Count).End(xlUp).Row
    For r = LR To 2 Step -1
        If (Range("O" & r).Value <> "Mdn") Then
            Rows(r).Delete
            Application.ScreenUpdating = True
        End If
    Next r
End Sub

 

[wigi]

This could be as simple as:

Sub removingrows()
    With [A1].CurrentRegion
        .AutoFilter 15, "<>Mdn"
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
End Sub

Wigi

 

[jeffreybrown]

How about this so you don't have to loop thru the cells...

Sub DeleteUnwanted()
    Const TextToKeep As String = "Mdn" '<-- Change to suit
    Application.ScreenUpdating = False
    With Range("O1", Range("O" & Rows.Count).End(xlUp))
        .AutoFilter Field:=1, Criteria1:="<>" & TextToKeep
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[Sunline]

Thanks for all replies . i failed to mention i have 171,000 rows to get thru so if some speed could be added that would be great .

Jeff i tried yours and it deleted my entire sheet except row1 headings .

wigi yours keeps running but not sure if working , what would be expected time to look thru this many rows .

Nalani same as wigi .

marreco just about to try yours now but am thinking may keep running on . Thanks .

 

[villy]

Try this.. supposed your last data is in column O

Sub delmdn()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "O").End(xlUp).Row
For i = lr To 2 Step -1
    For x = 1 To 15
        If Cells(i, x).Text = "Mdn" Then
            Exit For
        End If
        If x = 15 And Cells(i, x).Text <> "mdn" Then Cells(i, x).EntireRow.Delete
    Next
Next
Application.ScreenUpdating = True
End Sub

 

[villy]

Try this.. supposed your last data is in column O

Sub delmdn()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "O").End(xlUp).Row
For i = lr To 2 Step -1
    For x = 1 To 15
        If Cells(i, x).Text = "Mdn" Then
            Exit For
        End If
        If x = 15 And Cells(i, x).Text <> "mdn" Then Cells(i, x).EntireRow.Delete
    Next
Next
Application.ScreenUpdating = True
End Sub

Just correcting the value in red..

Sub delmdn()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "O").End(xlUp).Row
For i = lr To 2 Step -1
    For x = 1 To 15
        If Cells(i, x).Text = "Mdn" Then
            Exit For
        End If
        If x = 15 And Cells(i, x).Text <> "Mdn" Then Cells(i, x).EntireRow.Delete
    Next
Next
Application.ScreenUpdating = True
End Sub

 

[taurean]

Have a look at the following information:
http://www.ozgrid.com/VBA/row-delete-criteria.htm

 

[andrewman]

It seems too slow.