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]

thanks again, Alex
just I want understand this

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

is it problem even I use your suggestion ?

 

[Omran Y]

• formatting that was already in the OUTPUT sheet,

yes

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

sorry about it .

 

[Alex Blakenburg]

thanks again, Alex
just I want understand this

is it problem even I use your suggestion ?

Try it and you tell us ?
Based on your response to Peter, ClearContents should work for you.

 

[Omran Y]

that works Alex .

 

[Omran Y]

thanks Peter for your code .
thanks Kevin

 

[Peter_SSs]

thanks Peter for your code .

You're welcome. Since I had used Clear when ClearContents is apparently better for you, and I had omitted a "." I'll post the full amended code here.
If this still does what you want then you might consider amending the 'Mark as solution'.

Sub Del_Rows_Amended()
  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.ClearContents
    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]

You're welcome. Since I had used Clear when ClearContents is apparently better for you, and I had omitted a "." I'll post the full amended code here.

thanks, but I've found Alex Blakenburg 's suggestion doesn't work well !
from the first time will keep formatting and borders I make it manually for just specific rows and delete the borders for the rest of rows and when run the macro every time will delete borders and number format for all of rows.

 

[Peter_SSs]

Sorry, then I don't really know what you need.

 

[Omran Y]

Sorry, then I don't really know what you need.

well, the pictures will express my problems
PIC1 I create formatting & borders also number format C: E manually

what I want when I run the code every time should be like this(PIC2)

but your code when run the first time as in PIC3 , this is what I got

and when run again this is what I got as in PIC4

 

[Peter_SSs]

Since you have code moving the data to the OUTPUT sheet, why not have the code apply the relevant formatting to the used area as well?

On OUTPUT make sure that the heading row and row 2 have the formatting that you want. Doesn't matter about any other rows. You only have to do this once.

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

Sub Del_Rows_v4()
  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
  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