exclude multiple words when delete entire row for two columns

[Hasson]

Hello
I have about 15000 rows .
I want deleting entire row based on match on column B . theses words (SALES,BUYING,STOCK) shouldn't delete at all , other meaning should exclude from deletion , otherwise delete the others items in column B, I have another case in column A there are dates and some rows contains TOTAL word so should delete entire row for column A contains TOTAL word .
the data will be in range A:E and in Sheet1 and the result should implement for the same sheet .
thanks

 

[DanteAmor]

Try this:

Sub deleterows()
  Dim sh As Worksheet
  Dim rng As Range
  Dim i As Long, lr As Long
 
  Set sh = Sheets("Sheet1")
  lr = sh.Range("B" & Rows.Count).End(3).Row
  Set rng = sh.Range("B" & lr + 1)
 
  For i = 1 To lr
    Select Case UCase(sh.Range("B" & i).Value)
      Case "SALES", "BUYING", "STOCK"
      Case Else: Set rng = Union(rng, sh.Range("B" & i))
    End Select
    If UCase(sh.Range("A" & i).Value) = "TOTAL" Then: Set rng = Union(rng, sh.Range("B" & i))
  Next
 
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  rng.EntireRow.Delete
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

If the process is slow and you don't have formulas in the sheet, then try the following macro:

Sub deleterows_v2()
  Dim sh As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
 
  Set sh = Sheets("Sheet1")
  a = sh.Range("A1:E" & sh.Range("B" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
 
  For i = 1 To UBound(a, 1)
    If UCase(a(i, 2)) = "SALES" Or UCase(a(i, 2)) = "BUYING" Or UCase(a(i, 2)) = "STOCK" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next
  sh.Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------​

 

[Hasson]

all of your codes are great !
but where is this in second code? !

    If UCase(sh.Range("A" & i).Value) = "TOTAL" Then: Set rng = Union(rng, sh.Range("B" & i))

should also delete TOTAL word in column A as first code .

 

[DanteAmor]

The codes have different logic.
The first deletes the rows that meet the requirements.

The second code does not delete, the second code only keeps the data that the words have.
Assume that in the same row you don't have "TOTAL" in A and you don't have "SALES", "BUYING", "STOCK" in B in the same row.




But if it were the case where in the same row you have TOTAL and some of the words, then try this:

Sub deleterows_v2()
  Dim sh As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  Set sh = Sheets("Sheet1")
  a = sh.Range("A1:E" & sh.Range("B" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  
  For i = 1 To UBound(a, 1)
    If (UCase(a(i, 2)) = "SALES" Or UCase(a(i, 2)) = "BUYING" Or _
       UCase(a(i, 2)) = "STOCK") And a(i, 1) <> "TOTAL" Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        b(k, j) = a(i, j)
      Next
    End If
  Next
  sh.Range("A1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[Hasson]

perfect
thank you so much.