We help IT Professionals succeed at work.

VBA Code to delete rows that do not contain a specific value.

carlosab
carlosab asked
on
I am using this code but it is incredibly slow. I need something that will accomplish the same end more quickly. Also, the code that I'm using deletes my header row and I don't want it to do that. Thanks.

 
'   Delete rows that have a value other than "Lackawanna" or "Luzerne" in Column E, but, don't delete the top row.
    Dim rng1 As Range
    Dim lngRow As Long
    Application.ScreenUpdating = False
    If [e2] <> vbNullString Then
        Set rng1 = Range([e2], [e1].End(xlDown))
    Else
        Set rng1 = [e1]
    End If
    For lngRow = rng1.Rows.Count To 1 Step -1
        If Not (Cells(lngRow, "E") = "Lackawanna" Or Cells(lngRow, "E") = "Luzerne") Then
            Rows(lngRow).EntireRow.Delete
        Else
        '    If Left$(Cells(lngRow, "c"), 2) <> "CV" Then Rows(lngRow).EntireRow.Delete
        End If
    Next
    Application.ScreenUpdating = True

Open in new window

Comment
Watch Question

See if this works

'   Delete rows that have a value other than "Lackawanna" or "Luzerne" in Column E, but, don't delete the top row.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lngRow As Long
    Application.ScreenUpdating = False
    If [e2] <> vbNullString Then
        Set rng1 = Range([e2], [e1].End(xlDown))
    Else
        Set rng1 = [e1]
    End If
    For lngRow = rng1.Rows.Count To 1 Step -1
        If Not (Cells(lngRow, "E") = "Lackawanna" Or Cells(lngRow, "E") = "Luzerne") Then
            Rows(lngRow).EntireRow.Delete
            Set rng2 = Union(rng2, Rows(lngRow))
        Else
        '    If Left$(Cells(lngRow, "c"), 2) <> "CV" Then Rows(lngRow).EntireRow.Delete
        End If
    Next
            rng2.EntireRow.Delete
    Application.ScreenUpdating = True

Author

Commented:
ssaqibh - I get a Run-time error-5': Invalid procedure call or argument and the debug shows that the Set rng2 line is highlighted.

borgunit - I'm trying to modify one of those routines and am making some headway, but it might be over my head.

Author

Commented:
I'm most of the way there. I have code that immediately deletes all rows that have a certain value in  Column E. What I need is the reverse . . . the code needs to instead keep those rows and delete the other rows. Here is the code that needs to be reversed:

 
Step3:
    'Define Name that is present in rows to be deleted
    strCriteria = "Elk"
    
    'Store current Calculation then switch to manual.
    'Turn off events and screen updating
    With Application
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
        
        'Remove any filters
    ActiveSheet.AutoFilterMode = False
    
    With rRange 'Filter, offset(to exclude headers) and delete visible rows
      .AutoFilter Field:=lCol, Criteria1:=strCriteria
      .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    'Remove any filters
    ActiveSheet.AutoFilterMode = False
    
      'Revert back
    With Application
        .Calculation = xlCalc
        .EnableEvents = True
        .ScreenUpdating = True
    End With

Open in new window

Now try this. If there is still a problem the post an excel file so that I can test it.
Sub delrows()
'   Delete rows that have a value other than "Lackawanna" or "Luzerne" in Column E, but, don't delete the top row.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim lngRow As Long
    Application.ScreenUpdating = False
    If [e2] <> vbNullString Then
        Set rng1 = Range([e2], [e1].End(xlDown))
    Else
        Set rng1 = [e1]
    End If
    For lngRow = rng1.Rows.Count To 1 Step -1
        If Not (Cells(lngRow, "E") = "Lackawanna" Or Cells(lngRow, "E") = "Luzerne") Then
            'Rows(lngRow).EntireRow.Delete
            If rng2 Is Nothing Then
                Set rng2 = Rows(lngRow)
            Else
                Set rng2 = Union(rng2, Rows(lngRow))
            End If
        Else
        '    If Left$(Cells(lngRow, "c"), 2) <> "CV" Then Rows(lngRow).EntireRow.Delete
        End If
    Next
            rng2.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Open in new window

Author

Commented:
Works great, except that it deletes the header row, and doesn't run the analysis on the last row.

 Book22.xlsm
Just change line 3 to

strCriteria = "<>Elk"

perhaps.

Author

Commented:
"<>Elk" doesn't work, nor does: <> "Elk:
Change

    For lngRow = rng1.Rows.Count To 1 Step -1

to

    For lngRow = rng1.Rows.Count To 2 Step -1

Author

Commented:
Thanks! If you wouldn't mind taking a look at the next puzzle piece, I'd appreciate it: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_27482583.html

Author

Commented:
ssaqibh - I was hasty in awarding the points. Your last fix did address the header problem, but, the code still doesn't run the analysis on the last row.  
Try

    For lngRow = rng1.Row + rng1.Rows.Count - 1 To 2 Step -1