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

 

[dids86]

You're welcome.

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

I've got to say it is unreal! So fantastic thank you. Which leads me to something else. Can a similar macro be utilised for hiding rows instead of deleting them with the same conditions applied?

 

[Peter_SSs]

I've got to say it is unreal! So fantastic thank you.

Cheers. Yes, much faster than row-by-row deletion.

Can a similar macro be utilised for hiding rows instead of deleting them with the same conditions applied?

Yes

Sub HideNotNNN()
  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 .Cells(20, nc).Resize(UBound(a))
        .Value = b
        .SpecialCells(xlConstants).EntireRow.Hidden = True
        .ClearContents
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

 

[dids86]

Cheers. Yes, much faster than row-by-row deletion.


Yes

Sub HideNotNNN()
  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 .Cells(20, nc).Resize(UBound(a))
        .Value = b
        .SpecialCells(xlConstants).EntireRow.Hidden = True
        .ClearContents
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

Thanks Peter

 

[Peter_SSs]

Thanks Peter

No problem.