vba search, delete, and enter 0 for entire sheet row A

Hi,

Try below:

Sub FindAddDelete()
Dim i As Integer

For i = 1 To 500
    If Cells(i, 1).Value = "Envelop" Or Cells(i, 1).Value = "Pack" Or Cells(i, 1).Value = "Packages" Then
        If Cells(i, 1).Offset(1, 0).Range("A1") = "" Then
            Cells(i, 1).Offset(1, 0).Range("A1").Value = 0
            Cells(i, 1).EntireRow.Delete
        End If
    End If
Next i

End Sub

Select allOpen in new window

When deleting rows is faster to build a range to delete then just delete that range. My code will find all entries in column A that contain Envelope and check if the cell below is empty, add 0. It will find all entries of Pack and Package. it creates a range of rows to delete then deletes the rows in one action. This will be noticeably faster on large amounts of data. I think that is what you want

Option Explicit


Sub CleanUp()
    Dim rCl As Range, rRng As Range

    For Each rCl In Sheet1.UsedRange.Columns(1).Cells
        Select Case rCl.Value
        Case "Envelope"    ''/// if cell contains envelpe add 0 below it if required
             If rRng Is Nothing Then
                    Set rRng = rCl
                Else: Set rRng = Union(rRng, rCl)
                End If
                If IsEmpty(rCl.Offset(1)) Then rCl.Offset(1).Value = 0
        Case "Pack", "Packages"
            If rRng Is Nothing Then
                Set rRng = rCl
            Else: Set rRng = Union(rRng, rCl)
            End If
        End Select
    Next rCl
   rRng.EntireRow.Delete
End Sub

Select allOpen in new window

Before running above codes:
Roy's result:
My result:

The authoe did not say that he wanted 0 below packages or pack. If he does then the code can be easily fixed! My code even if it needs adapting will be more efficient than a Loop. I assume Pak is a typo

1. Look for all "Envelope" (whole cell).
2. Put a 0 in blank cell below "Envelope"
3. Remove row with Envelope
4. Look for all "Pak" (Whole cell)
5. Remove all rows with "Pack"
6. Look for all "Package" (Whole cell)
7. Remove all rows with "Packages"

Even for Envelope, your code doesn't provide 0 in blank cell below.

Yes it does!!
Test.xlsm

Roy_Cox - sorry for the confusion - Pak is not a typo, it is actually the text in the cell! :)  I can easily see how that would seem logical.
Also, you are correct, I don't need a 0 below Pak or Package, just the Envelope. I am going to try now...  Thanks.

Roy_Cox, Even though it runs in the test file you attached, when I put it into the project, I get an error Object Variable with Block variable not set.

Shums - I am using your code revised to get exactly what I need.
The problem is, it doesn't work through the ENTIRE sheet.
It does the first replace/remove, but then stops.
Can you understand this?

Sub FindAddDelete()
Dim i As Integer

For i = 1 To 500
    If Cells(i, 1).Value = "Envelope" Then
        If Cells(i, 1).Offset(1, 0).Range("A1") = "" Then
            Cells(i, 1).Offset(1, 0).Range("A1").Value = 0
            Cells(i, 1).EntireRow.Delete
        End If
    End If
Next i

For i = 1 To 500
    If Cells(i, 1).Value = "Pak" Or Cells(i, 1).Value = "Package" Then
            Cells(i, 1).EntireRow.Delete
        End If
Next i

End Sub

Select allOpen in new window

THANK YOU!! :)

You're Welcome! Glad I was able to help.

Without seeing an example I can only assume that your data is on a different sheet to Sheet1, it's a pity you do not give all helpers a chance to check their replies. I specified an actual sheet rather than rely on ActiveSheet, by doing so the button to run it could be placed on any sheet..