VBA to delete row if column does not contain a certain value

[Bomino]

Hello,
I have been digging/Googling for couple of hours for a possible easy solution to my problem. I have a worksheet with couple of 100K rows and I woud like to purge out ALL the rows that do NOT contain a certain text. I've found Ron's code http://www.rondebruin.nl/win/s4/win001.htm
and tweak it a little.....but it is taking for ever to run. Here is the code:

Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim inputData As String
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False
        inputData = InputBox("Enter Text to Keep:", "Input Box Text")
        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1
           
          ' Delete each row if the inputData value does NOT exist in the row (It will look in the whole row)
      If Application.CountIf(.Rows(Lrow), inputData) > 0 Then .Rows(Lrow).Delete
           

        Next Lrow

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

Could someone please help with a faster code?
Thank you.

 

[Hui]

If you have a specific column you are reviewing for a value
Change:

If Application.CountIf(.Rows(Lrow), inputData) > 0 Then .Rows(Lrow).Delete

To:

If Cells(Lrow, 1)=0  Then .Rows(Lrow).Delete 'Change the 1 to the Column No and 0 to the value you want to check

 

[Bomino]

Thanks Hui for your prompt response.
I would like to be able to select column based on need.
Would it be possible to make the column selection "dynamic"?

 

[Hui]

Before the For Lrow = Lastrow To Firstrow Step -1 loop
add:

Dim Col as Integer
col= Range("a1") 'Change to suit some reference

In the loop:

If Cells(Lrow, Col)=0  Then .Rows(Lrow).Delete 'Change the 0 to the value you want to check

 

[Bomino]

Hui,
The code amendment you've provided would delete ALL rows containing 0, right!? Would the following delete ALL rows without 0? Thanks

If Cells(Lrow, Col)<>0 Then .Rows(Lrow).Delete

 

[Hui]

Yes
That is it will delete all rows in Column Col that don't contain 0

Don't be afraid to try things
Always save a backup first!

 

[Bomino]

Thanks a lot Hui!!

 

[Bomino]

Hui,
I have made some changes as shown below, but for some reasons it's not working as desired. The code is deleting everything. What did I do wrong? Please advise. Thanks.

Sub DeleteRow()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim inputData As String
    Dim col As Range
    Dim SelectedCol As Range
  
    On Error Resume Next
    Set col = Application.InputBox("Please select Column!", _
                                              "Column Selection", Selection.Address, , , , , 8)
    If IsEmpty(col) Then
        MsgBox "It appears as if you've cancelled!"
        Exit Sub
    End If

  
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    With ActiveSheet

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False
        inputData = InputBox("Enter Text to Keep:", "Data Entry")
      
        If inputData = NullString Then Exit Sub
        On Error Resume Next
        'Set the first and last row to loop through
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

          
          ' Delete each row if the inputData value does NOT exist in the row (It will look in the whole row)
      If Cells(Lrow, col) <> inputData Then .Rows(Lrow).Delete
          

        Next Lrow

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub

 

[Hui]

I think your line:

 If IsEmpty(col) Then
  MsgBox "It appears as if you've cancelled!"
  Exit Sub
  End If

Should be:

 If IsEmpty(col) Then
  MsgBox "It appears as if you've cancelled!"
  Exit Sub
  End If
   
  col = col.Column