Delete row if it contains certain text with VBA

[Dokat]

Hi

I have a worksheet ("Region") with over 300K rows of data . I'd like to delete entire rows where intersecting column F value is "Total USA" with VBA.

For Ex: Delete row 4 if F4 is "Total USA".

I have below code however its giving me Runtime error 424. Appreciate any help modifying code. Thanks

Sub RowTotalUSA()
  Dim i As Long
 
  Application.ScreenUpdating = False
  With Sheets("Region")
    For i = .UsedRange.Row.Count To 1 Step -1
      If .Cells(Column.Count, i).End(xlUp).Column = "Total USA" Then .Row(i).Delete
    Next i
  End With
  Application.ScreenUpdating = True
End Sub

 

[Dokat]

Try the following:

Sub DeleteUSA()

Dim lrow As Long
Dim icntr As Long

lrow = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row


For icntr = lrow To 1 Step -1

If Cells(icntr, 6) = "Total USA" Then
         
        Rows(icntr).Delete
   
    End If

Next

End Sub

Thank you. This one worked. Changing to ActiveSheet.Range did the trick.

 

[kevin9999]

Another possibility?

Sub Dokat()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim Lr As Long, lc As Long, i As Long, j As Long, arr, result
    Application.ScreenUpdating = 0
    
    Lr = Cells.Find("*", , xlFormulas, , 1, 2).Row
    lc = Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    arr = ws.Range("F2:F" & Lr)
    ReDim result(1 To UBound(arr), 1 To 1)
    
    For i = 1 To UBound(arr)
        If arr(i, 1) = "Total USA" Then result(i, 1) = 1
    Next
    
    Cells(2, lc).Resize(UBound(result)) = result
    j = WorksheetFunction.Sum(Columns(lc))
    ws.Range(ws.Cells(2, 1), ws.Cells(Lr, lc)).Sort Key1:=ws.Cells(2, lc), order1:=1, Header:=2
    If j > 0 Then ws.Range("F2").Resize(j).EntireRow.Delete
    ws.Columns(lc).ClearContents
End Sub

 

[Dokat]

Another possibility?

Sub Dokat()
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim Lr As Long, lc As Long, i As Long, j As Long, arr, result
    Application.ScreenUpdating = 0
   
    Lr = Cells.Find("*", , xlFormulas, , 1, 2).Row
    lc = Cells.Find("*", , xlFormulas, , 2, 2).Column + 1
    arr = ws.Range("F2:F" & Lr)
    ReDim result(1 To UBound(arr), 1 To 1)
   
    For i = 1 To UBound(arr)
        If arr(i, 1) = "Total USA" Then result(i, 1) = 1
    Next
   
    Cells(2, lc).Resize(UBound(result)) = result
    j = WorksheetFunction.Sum(Columns(lc))
    ws.Range(ws.Cells(2, 1), ws.Cells(Lr, lc)).Sort Key1:=ws.Cells(2, lc), order1:=1, Header:=2
    If j > 0 Then ws.Range("F2").Resize(j).EntireRow.Delete
    ws.Columns(lc).ClearContents
End Sub

Thank you this one worked as well.