ignore deletion rows for items based on part of item

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.

Hasson,

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

        Else
        '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"
        Rows(i).Delete

    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   :-)