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]

@kevin9999
the code just works perfectly with small data as in OP , but with big data will stop and shows application defined error in this line

d.Remove (tmp)

 

[kevin9999]

@kevin9999
the code just works perfectly with small data as in OP , but with big data will stop and shows application defined error in this line

d.Remove (tmp)

Thank you for the feedback. Just curious, how big is the data you're using (8k?). I would recommend that you try Peter's code from post #10 - much more efficient than mine.

 

[Omran Y]

If there are quite a few disjoint rows to delete in that range then I think that you may find this faster.

wow !
this is really fast , it gives 0.02 sec , but unfortunately implement for the same sheet
the result should be in the OUTPUT sheet
as to

this could be tried instead.

I don't think to work correctly !
just delete CASH PREPAID and gives 0.220 , so the post#8 is better.

 

[Omran Y]

how big is the data you're using (8k?).

yes

I would recommend that you try Peter's code from post #10 - much more efficient than mine.

I really did it and wait for him what he comments .

 

[Peter_SSs]

For speed on large data, give this version a try.

Sub Del_Rows()
  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")
    RX.Pattern = "\b(" & Join(Application.Transpose(.Range("G2", .Range("G" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
    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
  With Sheets("OUTPUT")
    .UsedRange.Clear
    With Range("A1").Resize(UBound(a), nc)
      .Value = a
      If k > 0 Then
        Application.ScreenUpdating = False
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
        .Offset(1).Resize(k).EntireRow.Delete
        Application.ScreenUpdating = True
      End If
    End With
  End With
End Sub

 

[Omran Y]

For speed on large data, give this version a try.

thanks again
still implement for ACS sheet !

 

[Alex Blakenburg]

thanks again
still implement for ACS sheet !

Try adding a Period "." before the With Range towards the bottom of the code. (actually its before the Range)

    With .Range("A1").Resize(UBound(a), nc)

 

[Omran Y]

Try adding a Period "." before the With Range towards the bottom of the code.

thanks the code still fix things
the code will delete formatting and borders in OUTPUT sheet .

 

[Alex Blakenburg]

You may be able to get away with changing Clear to ClearContents.

    .UsedRange.ClearContents

We could bring the formatting across to the output if that doesn't work.
If you have borders inside your data set that is a little trickier, while other formatting moves with the cell when the data is sorted borders stay with the row number they are applied to. So you would need to see a visual of your, before, after and expected.

 

[Peter_SSs]

the code will delete formatting and borders in OUTPUT sheet .

Can you clarify if that is

• formatting that was already in the OUTPUT sheet, or
• formatting that is in the ACS sheet that should be copied across to the OUTPUT sheet when the data gets copied?

BTW, would be good to specify all these things at the beginning rather than bit-by-bit.