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

 

[Romano_odK]

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

Is it a formal Excel table?

Its a table filled through our SQL server.

Locatie controle 3.34 beta.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Datum	2023/11/16
2	Export folder	c:\temp\Locatie-overslagregels.xml
3	Omschrijving	Locatie overslagregels
4	Dagboek	90
5	Regels	1
6	Artikelcode	Omschrijving	Ontvgstdatum	Aantal	Kostprijs	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad	van Locatie	naar Locatie	Verplaats
7	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	11/07/2023	96	6,70	3901	P02B	1	A00	0
8	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	11/07/2023	96	6,70	3901	P02B	1	P02B	77
9	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	18/04/2023	96	6,70	3901	P04B	1	A00	0
10	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	18/04/2023	96	6,70	3901	P04B	1	P04B	90
11	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7,31	3901	P02B	1	A00	0
12	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7,31	3901	P02B	1	AAP	0
13	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7,31	3901	P02B	1	P02B	104
14	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	25/04/2023	96	7,31	3901	P04B	1	A00	0
15	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	25/04/2023	96	7,31	3901	P04B	1	P04B	19
Boekingen

Cell Formulas
Range	Formula
B5	B5	=COUNTA(#REF!)

 

[Peter_SSs]

Thanks for the XL2BB sample data. The sample shows two things to me ..

1. Your original 'working' code checked up from the bottom, including row 6, so mine did too. In this sample however row 6 is a heading so I presume should not be considered for deletion? Please clarify.
   
   
2. In this sample every row would be deleted because one of your code conditions is delete the row if column J is greater than or equal to 0. In this sample every row meets that condition. In your larger actual data are there any rows where col J is not >=0? If so, could we have another sample where some rows would be deleted and some would not?

 

[6StringJazzer]

In your larger actual data are there any rows where col J is not >=0?

That column is for "stock" so it wouldn't make sense for it to be negative. I'm betting it should be ">0" and not ">=0"

 

[rlv01]

Usually it is faster to use filtering to define the range of rows that need deleting and delete them as a block

'Delete all rows that meet criteria in column FilterColumn
'FilterRange must include a header row
Sub DeleteRows(FilterRange As Range, FilterColumn As Long, Criteria As Variant, WS As Worksheet)
    Dim DataRange As Range
    Dim DeleteRange As Range
   
    WS.AutoFilterMode = False
    Set DataRange = FilterRange.Offset(1).Resize(FilterRange.Rows.Count - 1)    'excludes header row
   
    Application.ScreenUpdating = False
   
    FilterRange.AutoFilter Field:=FilterColumn, Criteria1:=Criteria
    Set DeleteRange = Application.Intersect(FilterRange.SpecialCells(xlCellTypeVisible).EntireRow, DataRange.EntireRow)
   
    If Not DeleteRange Is Nothing Then
        DeleteRange.Delete                            'delete rows
    End If
    WS.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Sub Example()
    Dim WS As Worksheet
    Dim rng As Range

    Set WS = ActiveSheet
    With WS
        Set rng = .Range("A6:M" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    
    DeleteRows rng, 8, "=1", WS
    DeleteRows rng, 10, ">=0", WS
End Sub

If you wanted to delete everything with a single call to Sub DeleteRows you would need to define a helper column with a boolean formula identifiying each row than needed to be deleted.

 

[Romano_odK]

Thanks for the XL2BB sample data. The sample shows two things to me ..

1. Your original 'working' code checked up from the bottom, including row 6, so mine did too. In this sample however row 6 is a heading so I presume should not be considered for deletion? Please clarify.
   
   
2. In this sample every row would be deleted because one of your code conditions is delete the row if column J is greater than or equal to 0. In this sample every row meets that condition. In your larger actual data are there any rows where col J is not >=0? If so, could we have another sample where some rows would be deleted and some would not?

Good afternoon Peter,

You are right about the headers, row 6 should have been row 7. Column J has indeed values less then 0 which should not happen but they do so I have to take them into account.

Locatie controle 3.34 beta.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Artikelcode	Omschrijving	Ontvgstdatum	Aantal	Kostprijs	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad
7	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	11/07/2023	96	6,70	3901	P02B	1	A00	0
8	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	11/07/2023	96	6,70	3901	P02B	1	P02B	77
9	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	18/04/2023	96	6,70	3901	P04B	1	A00	0
10	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	18/04/2023	96	6,70	3901	P04B	1	P04B	70
11	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7,31	3901	P02B	1	A00	0
12	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7,31	3901	P02B	1	AAP	0
13	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7,31	3901	P02B	1	P02B	-10
14	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	25/04/2023	96	7,31	3901	P04B	1	A00	0
15	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	25/04/2023	96	7,31	3901	P04B	1	P04B	19
16	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	06/09/2023	96	9,89	3901	P02B	1	P02B	81
17	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	06/09/2023	96	9,89	3901	P02B	1	P02C	60
18	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	06/09/2023	96	9,89	3901	P02B	1	A00	0
19	100005	Vito Glaserfix 111 6x4 mm zwart - 10x25 m	31/03/2021	96	9,89	3901	AAP	1	A00	0
20	100005	Vito Glaserfix 111 6x4 mm zwart - 10x25 m	31/03/2021	96	9,89	3901	AAP	1	P04B	53
21	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7,74	3901	P01B	1	A00	-1
22	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7,74	3901	P01B	1	AAP	0
23	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7,74	3901	P01B	1	P01B	80
Boekingen

 

[Peter_SSs]

Thanks for the new sample data. Due to the different header information discussed above, I made this one small change to your original code which you said worked ..

Sub Post_1_Code()
    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 7 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
End Sub

.. and ran it on this latest sample data. This is the result

Romano_odK.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Artikelcode	Omschrijving	Ontvgstdatum	Aantal	Kostprijs	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad
7	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7.31	3901	P02B	1	P02B	-10
8	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7.74	3901	P01B	1	A00	-1
9
Sheet3 (2)

I then ran my code from post #3 with two tiny changes (again to adjust for the different header row) ...

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("H7: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("A7").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

.. on the latest sample data. This is the result

Romano_odK.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Artikelcode	Omschrijving	Ontvgstdatum	Aantal	Kostprijs	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad
7	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7.31	3901	P02B	1	P02B	-10
8	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7.74	3901	P01B	1	A00	-1
9
Sheet3 (3)

the results are identical so not sure why you say your code works and my code ..

unfortunately it messes up my table totally.

 

[Romano_odK]

Thanks for the new sample data. Due to the different header information discussed above, I made this one small change to your original code which you said worked ..

Sub Post_1_Code()
    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 7 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
End Sub

.. and ran it on this latest sample data. This is the result

Romano_odK.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Artikelcode	Omschrijving	Ontvgstdatum	Aantal	Kostprijs	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad
7	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7.31	3901	P02B	1	P02B	-10
8	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7.74	3901	P01B	1	A00	-1
9
Sheet3 (2)

I then ran my code from post #3 with two tiny changes (again to adjust for the different header row) ...

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("H7: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("A7").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

.. on the latest sample data. This is the result

Romano_odK.xlsm
	A	B	C	D	E	F	G	H	I	J
6	Artikelcode	Omschrijving	Ontvgstdatum	Aantal	Kostprijs	Vrrdrek	Std_locatie	Magazijn	Locatie	Voorraad
7	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	7.31	3901	P02B	1	P02B	-10
8	100006	Vito Glaserfix 111 9x2 mm wit - 10x25 m	07/11/2023	120	7.74	3901	P01B	1	A00	-1
9
Sheet3 (3)

the results are identical so not sure why you say your code works and my code ..

Good morning,
My excuses for taking so long. I have tried it again and it works perfectly. I think it indeed had to do with the header at first, but I am not sure. Thank you for your time and efforts. I wish you a great day.

 

[Peter_SSs]

Good news! Thanks for the follow-up.
Hopefully it should be very fast.

 

[Romano_odK]

Good news! Thanks for the follow-up.
Hopefully it should be very fast.

Oh yes it is very fast. Have a nice weekend.

 

[FormR]

Its a table filled through our SQL server.

Hi, if you're importing this table with Power Query (Data > Get Data) then you can remove the unwanted rows with the query editor without any code.