Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

ignore deletion rows for items based on part of item



I  search  for  way  to  delete all of rows don't  contain CASH PP, CASH SS.

 what I want the  code   should match  part  of  item CASH PP, CASH SS based on column B  becuase  will contain characters  ,if  there   rows contain CASH PP, CASH SS  regardless what contain characters after it  should  keep  it  otherwise  delete  the  others .

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 "CASH PP", "CASH SS"
      Case Else: Set rng = Union(rng, sh.Range("B" & i))
    End Select

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub


Hello Hasson,

Just want some clarification first. In the sample file provided, you want to delete rows 2 thru 6 and rows 13 thru 18, and keep row1 and rows 7 thru 12, correct? Your code as written deletes all rows.
WillieD24 (rep: 567) Aug 13, '23 at 6:00 pm
Add to Discussion


Selected Answer

Hi again Hasson

As Willie says, you need to step backwards in (up) column B. Given your intention to add more "retain" words, I suggest you put them in an array, which I've declared as the variant Words. You can add many more words very simply (but it might slow the code down and you may need to turn off Application.ScreenUpdating but that really isn't needed in this example file)

Then, within the rows loop backwards, you need to loop through all of that array for  and test for the words in the array using the VBA command InStr (in string). After that's been done, if the flag Fnd (for "Find") is still False, the row can be deleted. 

Key bits are in bold below and the revised code is in the attached revised file. 

Sub deleterows()
     Dim sh As Worksheet
     Dim i As Long, lr As Long
     Dim Words As Variant, n As Long

     ' create an array of the words for rows to be kept
     Words = Array("CASH PP", "CASH SS")
     Set sh = Sheets("Sheet1")

     With sh
        ' find last row in B
         lr = .Cells(Rows.Count, 2).End(xlUp).Row
         ' loop backwards since deleting
         For i = lr To 2 Step -1
            ' reset flag then...
            Fnd = False
            ' ... loop to check against each word in the array
            For n = LBound(Words) To UBound(Words)
                 ' if any match found, set flag Fnd
                If InStr(.Cells(i, 2).Value, Words(n)) <> 0 Then
                    Fnd = True
                    ' stop looking
                    Exit For
                End If
            Next n
            ' delete if no match was found
            If Fnd = False Then Rows(i).Delete
         Next i
    End With

End Sub

Note that I changed the properties of your Delete button to "Don't move or size with cells" since it got squashed vertically otherwise.

Hope this is what you need.



Hi John,
(but it might slow the code down ...
I think this is the only way to do that by array , as to speed I don't think to effect profoundly
the  solution is perfect and  what I  want it.
thank  you, John.
Hasson (rep: 32) Aug 14, '23 at 12:05 pm
Thanks for selecting my Answer, Hasson. Turing off Updating would be better is you had hundreds of row but for a few rows, you don't really see the difference.
John_Ru (rep: 6297) Aug 14, '23 at 2:25 pm
Add to Discussion


If the answer to my question above is "Yes" then change your code to the following:

Sub Delete_Rows_2()

' macro written by WillieD24 for teachexcel.com
' delete any row that doesn't contain "CASH PP" or "CASH SS" in column "B"

Dim sh As Worksheet   ' worksheet where rows will be deleted
Dim LR As Long   ' last used row in column "B"
Dim i As Long   ' used to control when procedure will end

Set sh = Sheets("Sheet1B")   ' this is the sheet used for testing
LR = sh.Range("B" & Rows.Count).End(xlUp).Row

'Application.ScreenUpdating = False

For i = LR To 2 Step -1   ' need to work from bottom up because rows are being deleted
' check if "B" contains "CASH PP" or "CASH SS"
If Application.WorksheetFunction.CountIf(Cells(i, "B"), "CASH PP*") = 1 Or _
            Application.WorksheetFunction.CountIf(Cells(i, "B"), "CASH SS*") = 1 Then
            'MsgBox "YUP  " & "row  " & i
            Cells(i, 2).Select   ' used to track progreesion

        'MsgBox "NOPE  " & "row  " & i
        Cells(i, 2).Select   ' used to track progreesion
        ' delete the entire row if there is no "CASH PP" or "CASH SS"

    End If

Next i

'Application.ScreenUpdating = True
End Sub

In the attached file (copy of your original) you can see how this works.

If this code does what you are looking to do, please mark my answer as selected.

Cheers   :-)



but  I  don't  way  using   countif function  for  each  word  . I  want  using  for  one  line  fo  multiple  words  as  the  code  does it when use  select case   becuase I  will  add more words  then  based  on  your  way  I   need  to add  too much  lines    for  each  word  when  use  countif  function !
Hasson (rep: 32) Aug 14, '23 at 2:47 am
Hasson. I've suggested an alternative, flexible answer but next time please add the intention to expand the words list in your original question
John_Ru (rep: 6297) Aug 14, '23 at 11:01 am

Nice one John, Completely agree that complete information in the original post would have gotten Hasson an answer sooner. (similar to another recent post I spent a lot of time on)

Note: I have my VB Editor set to "Option Explict" so when I tried your code I had to add: "Dim Fnd As Boolean"

Cheers   :-)
WillieD24 (rep: 567) Aug 14, '23 at 1:09 pm
@Willie-  Option Explicit is a good thing but I'm often in a rush and take the gamble
John_Ru (rep: 6297) Aug 14, '23 at 2:23 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login