Making it filter and not delete the lines

[Romano_odK]

Good morning,

Got this code and by definition it works, but its really slow so I am looking for either another and fast solution or make it a filter only. So that last part, can this be done with this code, so to make it filter only?

Thank you for your time.

Dim lr As Long
    Dim r As Long
    
    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, "I") <> "AAP") Or (Cells(r, "J") = 0) Then
'           Delete row
            Rows(r).Delete
        End If
    Next r
    
    Application.ScreenUpdating = Tru

 

[Peter_SSs]

Little bit of a guess without seeing any sample data, but give this a try with a copy of your data.

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("I6: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, 1) <> "AAP" Or a(i, 2) = 0 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

 

[Romano_odK]

Little bit of a guess without seeing any sample data, but give this a try with a copy of your data.

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("I6: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, 1) <> "AAP" Or a(i, 2) = 0 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

Unfortunately it crashes, so I added the top part of this sheet. Its more then 6000 lines so I hope this will do.

Locatie controle 3.34 beta - Copy.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Datum	2024/02/06
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	1,00	3901	P02B	1	P02B	32
8	100000	Vito Glaserfix 111 6x2 mm wit - 10x25 m	11/07/2023	96	2,00	3901	P02B	1	A00	0
9	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	18/04/2023	96	3,00	3901	P04B	1	P04B	-20
10	100001	Vito Glaserfix 111 6x2 mm zwart - 10x25 m	18/04/2023	96	41,00	3901	P04B	1	A00	0
11	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	54,00	3901	P02B	1	A00	0
12	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	5,00	3901	P02B	1	AAP	0
13	100002	Vito Glaserfix 111 6x3 mm wit - 10x25 m	15/11/2023	96	4,00	3901	P02B	1	P02B	-69
14	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	08/01/2024	96	4,00	3901	P04B	1	A00	0
15	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	08/01/2024	96	5,00	3901	P04B	1	AAP	0
16	100003	Vito Glaserfix 111 6x3 mm zwart - 10x25 m	08/01/2024	96	5,00	3901	P04B	1	P04B	91
17	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	06/09/2023	96	4,00	3901	P02B	1	A00	0
18	100004	Vito Glaserfix 111 6x4 mm wit - 10x25 m	06/09/2023	96	9,89	3901	P02B	1	P02C	60
Boekingen

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

 

[Peter_SSs]

You said the code in post 1 works.
For the sample data shown in post 3 the post 1 code deletes every line of data and the heading row in row 6.
My code in does exactly the same thing but faster, which is what you asked for as I understood it.

So, ..

1. Should the code only check row 7 and below, not row 6 and below as per your original code?
   
   
2. What about you give some relevant sample data where not every row would get deleted? .. and then manually delete the rows that should be deleted and post that separately also with XL2BB?