Is there something faster to erase lines?

[Romano_odK]

Good afternoon,

Got this code which works, but deleting those from a 10000 row table isn't really fast. Does anyone know if there is a faster way to do this?

Thank you for your time.

    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows backwards, up to row 6
    For r = lr To 6 Step -1
'       See if columns H, I, or J is empty
        If (Cells(r, "J") >= "0") Or (Cells(r, "H") <> "1") Then
'           Delete row
            Rows(r).Delete
        End If
    Next r
    
    Application.ScreenUpdating = True

 

[Fluff]

What is the last used column on that sheet?

 

[Peter_SSs]

Not sure if those values in columns H & J are actually numerical or text but give this a try with a copy of your worksheet.

Sub Del_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("H6:J" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 3) >= 0 Or a(i, 1) <> 1 Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A6").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 Sub

 

[6StringJazzer]

This should be faster. Update column references for J to the actual last column.

    Dim lr As Long
  
    Application.ScreenUpdating = False
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    Range("A5:J5").AutoFilter
    
    Range("$A$5:$J$" & lr).AutoFilter Field:=8, Criteria1:="<>1", Operator:=xlAnd
    Range("$A$6:$I$" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    Range("$A$5:$J$60").AutoFilter Field:=8
        
    Range("$A$5:$J$60").AutoFilter Field:=10, Criteria1:=">=0", Operator:=xlAnd
    Range("$A$6:$I$" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    Range("A5:J5").AutoFilter
    
    Application.ScreenUpdating = True

 

[Romano_odK]

What is the last used column on that sheet?

M

 

[6StringJazzer]

One other note: I an inferring that the values in your worksheet are numeric, so don't put them in quotes in your code.

 

[Romano_odK]

One other note: I an inferring that the values in your worksheet are numeric, so don't put them in quotes in your code.

Ok and yes they are numeric. Thank you.

 

[Fluff]

Peter has already posted similar code to what I was going to do, so try that & 6strings code.

 

[Romano_odK]

Not sure if those values in columns H & J are actually numerical or text but give this a try with a copy of your worksheet.

Sub Del_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("H6:J" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 3) >= 0 Or a(i, 1) <> 1 Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A6").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 Sub

Thank you for your reply, unfortunately it messes up my table totally.

 

[Peter_SSs]

unfortunately it messes up my table totally.

Perhaps you could show us what your table looks like with XL2BB?

Is it a formal Excel table?