VBA to Delete Rows based on Specific Text appearing in a column

[dids86]

Hi,

I'm using an excel workbook with multiple sheets but within the sheet called REP500, I'd like to run a macro that deletes all rows where the value isn't "NNN" in column AF

Would anyone be able to suggest a suitable macro for this please? It's likely to need to run down to 10,000 rows.

Thanks

Tom

 

[Rhodie72]

Bear in mind that you cannot undo anything done by VBA, so test this on a copy of the document you want to check

Sub DeleteRowsNotNNN()
    Dim ws As Worksheet,lastRow As Long, i As Long

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets(inputbox "Type the name of the sheet you want to modify","Replace with your sheet name if necessary","Sheet1")

    ' Find the last row in the sheet based on column AF
    lastRow = ws.Cells(ws.Rows.Count, "AF").End(xlUp).Row

    ' Loop through the rows from the last to the first to avoid skipping rows
    For i = lastRow To 1 Step -1
        ' Check if the value in column AF is not "NNN"
        If ws.Cells(i, "AF").Value <> "NNN" Then
            ' Delete the entire row if value is not "NNN"
            ws.Rows(i).Delete
        End If
    Next i

 

[dids86]

Thank you very much

 

[Rhodie72]

Thank you very much

You're welcome. Here's an easier version that uses the current sheet as the default name

Sub DeleteRowsNotNNN()
    Dim ws As Worksheet,lastRow As Long, i As Long

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets(inputbox "Type the name of the sheet you want to modify","Replace with your sheet name if necessary",activeworksheet.name)

    ' Find the last row in the sheet based on column AF
    lastRow = ws.Cells(ws.Rows.Count, "AF").End(xlUp).Row

    ' Loop through the rows from the last to the first to avoid skipping rows
    For i = lastRow To 1 Step -1
        ' Check if the value in column AF is not "NNN"
        If ws.Cells(i, "AF").Value <> "NNN" Then
            ' Delete the entire row if value is not "NNN"
            ws.Rows(i).Delete
        End If
    Next i

 

[Peter_SSs]

@dids86
If you have to do that again with that size data and a reasonable number of disjoint rows to delete, you should find this much faster.
It does depend a bit on the actual sample data but with my sample data of 10,000 rows the code you have marked in post 2 (after the syntax error has been corrected) took about 6 seconds to run. The code below produced the same results in 0.086 seconds.

Sub DeleteNotNNN()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long

  With Sheets("REP500")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("AF1", .Range("AF" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) <> "NNN" Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

 

[dids86]

Hi Peter,

Thanks for that. Is there a way to include an additional condition so that a specific row is ignored from the macro, Row 18 for example or a way to set the macro so that it only starts from row 20 down?

Thanks

Tom

 

[Peter_SSs]

or a way to set the macro so that it only starts from row 20 down?

Sure, to start deletion for non-NNN rows from row 20 down, just 2 changes (highlighted red) ..

Sub DeleteNotNNN_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long

  With Sheets("REP500")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("AF20", .Range("AF" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) <> "NNN" Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A20").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

 

[Joe4]

Hi Peter,

Thanks for that. Is there a way to include an additional condition so that a specific row is ignored from the macro, Row 18 for example or a way to set the macro so that it only starts from row 20 down?

Thanks

Tom

I locked your other thread asking the same question. As is stated in our rules, please do not ask the same question in multiple threads.

 

[dids86]

Sure, to start deletion for non-NNN rows from row 20 down, just 2 changes (highlighted red) ..

Sub DeleteNotNNN_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long

  With Sheets("REP500")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("AF20", .Range("AF" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) <> "NNN" Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A20").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

That's fantastic thank you!

 

[Peter_SSs]

That's fantastic thank you!

You're welcome.

Did you get a noticeable speed improvement with your own data?