delete 8000 rows based on what I write items in helper column

[Omran Y]

Hi
I want فخ delete entire row based on helper column (G) .should match the whole item for each cell in column G with column B then should delete entire row , but be careful you will see many similar items may be you think should delete it but in reality not . should match the whole item in column G with column B. if you see the part of item is existed in column B but not whole as in column G then should not delete it.
I have about 8000 rows and every time I will add new items in column G.

OM1.xlsm
	A	B	C	D	E	F	G
1	DATE	OPERATION NAME	DEBIT	CREDIT	BALANCE		ITEMS
2	01/03/2023	BB IN TPUT TTR120 CASH PREPAID	10,000.00		10,000.00		CASH PREPAID
3	02/03/2023	PREPAID CASH BBI-60 IN TPUT MM200	2,000.00		12,000.00		BANK SWIFT
4	03/03/2023	BANK SWIFT FG-1005	30,000.00		42,000.00		INVOICE NUMBER SS
5	04/03/2023	MS.9888485 BANK SWIFT FG-1001	60,000.00		102,000.00
6	05/03/2023	PAID BANK MTSWF90001		2,000.00	100,000.00
7	06/03/2023	SWIFT BANK FGS-100101	10,000.00		110,000.00
8	07/03/2023	CASH PREPAID BBFG IN TPUT LM7040	30,000.00		140,000.00
9	08/03/2023	INN702000 CASH PIAD		6,000.00	134,000.00
10	09/03/2023	CASH PIAD MN90400 UY600M		1,000.00	133,000.00
11	10/03/2023	CASH FROM CURS	1200		134,200.00
12	11/03/2023	CSDF SWIFT REF678999	2000		136,200.00
13	12/03/2023	CRTM RT500 CVF 789/7788	1300		137,500.00
14	10/03/2023	INVOICE NUMBER SS OMM-1000	2300		139,800.00
15	11/03/2023	INVOICE NUMBER SS OMM-1001	2200		142,000.00
16	12/03/2023	INVOICE NUMBER SS OMM-1002	2500		144,500.00
17	13/03/2023	INVOICE NUMBER RR OMM-1003	2800		147,300.00
18	14/03/2023	INVOICE NUMBER RR OMM-1004	3100		150,400.00
ACS

the output should be like this

OM1.xlsm
	A	B	C	D	E
1	DATE	OPERATION NAME	DEBIT	CREDIT	BALANCE
2	02/03/2023	PREPAID CASH BBI-60 IN TPUT MM200	2,000.00		12,000.00
3	05/03/2023	PAID BANK MTSWF90001		2,000.00	100,000.00
4	06/03/2023	SWIFT BANK FGS-100101	10,000.00		110,000.00
5	08/03/2023	INN702000 CASH PIAD		6,000.00	134,000.00
6	09/03/2023	CASH PIAD MN90400 UY600M		1,000.00	133,000.00
7	10/03/2023	CASH FROM CURS	1200		134,200.00
8	11/03/2023	CSDF SWIFT REF678999	2000		136,200.00
9	12/03/2023	CRTM RT500 CVF 789/7788	1300		137,500.00
10	13/03/2023	INVOICE NUMBER RR OMM-1003	2800		147,300.00
11	14/03/2023	INVOICE NUMBER RR OMM-1004	3100		150,400.00
OUTPUT

 

[Omran Y]

why not have the code apply the relevant formatting to the used area as well?

I'm afraid the code will slow down when the big data contains formatting , so I prefer doing manually and the code just search for values .
about formatting has fixed and works very well.

Now try this code a few times with different items in column G of ACS sheet.

after clearing items in column G and add many times and especially when I have just item in G2 then will show mismatch error in this line .

RX.Pattern = "\b(" & Join(Application.Transpose(.Range("G2", .Range("G" & Rows.Count).End(xlUp)).Value), "|") & ")\b"

 

[Peter_SSs]

I'm afraid the code will slow down when the big data contains formatting

Have you tested that theory with my code to see how much it slows down?

when I have just item in G2 then will show mismatch error

Assuming that you will have something in G2 at least ..

Sub Del_Rows_v5()
  Dim RX As Object
  Dim a As Variant
  Dim nc As Long, i As Long, k As Long
 
  Set RX = CreateObject("VBScript.RegExp")
  With Sheets("ACS")
    If IsEmpty(.Range("G3").Value) Then
      RX.Pattern = "\b" & .Range("G2").Value & "\b"
    Else
      RX.Pattern = "\b(" & Join(Application.Transpose(.Range("G2", .Range("G" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
    End If
    nc = 6
    a = .Range("A1:F" & .Range("A" & Rows.Count).End(xlUp).Row).Value
  End With
  For i = 2 To UBound(a)
    If RX.test(a(i, 2)) Then
      a(i, 6) = 1
      k = k + 1
    End If
  Next i
  Application.ScreenUpdating = False
  With Sheets("OUTPUT")
    .UsedRange.Offset(2).Clear
    With .Range("A1").Resize(UBound(a), nc)
      .Rows(2).ClearContents
      .Rows(2).Copy Destination:=.Offset(1).Resize(UBound(a) - 1)
      .Value = a
      If k > 0 Then
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
        .Offset(1).Resize(k).EntireRow.Delete
      End If
      Application.Goto .Cells(1, 1), True
    End With
  End With
  Application.ScreenUpdating = True
End Sub

 

[Omran Y]

Have you tested that theory with my code to see how much it slows down?

as I expected will slow down , but not big difference.
your first answer , now gives 0.16 sec
and last answer will be 0.220 sec
anyway your code is really fast , I don't expect to get better than your code with all of my respect & appreciating for others members.
thanks Peter for this great work .

 

[Peter_SSs]

but not big difference.
your first answer , now gives 0.16 sec
and last answer will be 0.220 sec

I thought as much, 0.06 seconds difference would not even be noticeable.
In any case the first code did not do the required job and the last one apparently does, so comparing the times is pretty pointless.

thanks Peter

You are welcome.