Find and delete range of data

What I need is some code that will do the below code for a range of data with each new search searching the next cell, first pass the if statement checks O5 and then runs the search on N5 to delete the data. The second pass would then check O6 and run the search on N6. The range that would need to be searched and purged would be O2:O750. If anyone has any ideas on how to do this differently I'm open to suggestions, but at the very least if someone could help with what I ask even if it isn't the most effective.

If Range("O5").Value = 1 Then
    Columns("A:J").Select
    Selection.Replace What:=Range("N5"), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End If

Hi randell.graybill
try some thing like....

with worksheets("your sheet")
eitem = myarray(.range("O5"), .range("N5"), .range("O6"), .range("n6"))
for i = 0 To 2 step 2
with columns("A:J")
If eitem(i) = 1 then

Replace What:=eitem(i + 1), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End If
next i
end with
end with

Try this

Option Explicit

Sub check()

    Dim rChk As Range
    Dim rDel As Range
    Dim rCl As Range

    Set rChk = Range(Cells(2, 15), Cells(750, 15)).SpecialCells(xlCellTypeConstants)

    For Each rCl In rChk
        If rCl.Value = 1 Then
            If rDel Is Nothing Then
                Set rDel = rCl.Offset(0, -1)
            Else: Set rDel = Union(rDel, rCl.Offset(0, -1))
            End If
            rDel.Value = ""
        End If
    Next rCl
End Sub

Not to sure of what you are trying to do, posting a sample workbook showing before and after would help.

However you could try..........

Code removed.

Read the Question Alistair

I must remember "Put the brain in gear before engaging the mouth"

opps tested this one

Option Explicit
Sub pTest()
    Dim eitem, ikey As Byte
    With Worksheets("Sheet1")
        eitem = Array(.Range("O5"), .Range("N5"), .Range("O6"), .Range("N6"))
        For ikey = 0 To 2 Step 2
            With Columns("A:J")
                If eitem(ikey) = 1 Then
                    .Replace What:=eitem(ikey + 1), Replacement:="", LookAt:=xlPart, _
                             SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                             ReplaceFormat:=False
                End If
            End With
        Next ikey
    End With
End Sub

ok read the question
maybe

Option Explicit
Sub pTest()
    Dim eitem, ikey As Long
    With Worksheets("Sheet1").Range("N5:O750")
        eitem = .Value
         For ikey = 1 To UBound(eitem, 2)
            With Columns("A:J")
                If eitem(ikey, 2) = 1 Then
                    .Replace What:=eitem(ikey, 1), Replacement:="", LookAt:=xlPart, _
                             SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                             ReplaceFormat:=False
                End If
            End With
        Next ikey
    End With
End Sub

It will be interesting to see if there is any noticable speed difference between codes

Originally Posted by pike

It will be interesting to see if there is any noticable speed difference between codes

I haven't tested speed,but in my code I use special cells to only select cells with values, then create one range to work with. I would think that would be faster

Just created a workbook with dummy data in & run code to check speeds of mine & Pike's, here's the results

check is Faster

SearchAndReplace: 2.252065
check: 1.980469
Diff: 0.271596 Seconds

Note I have added error handling to handle the possibility that nocells meet the criteria

Sub check()

    Dim rChk As Range
    Dim rDel As Range
    Dim rCl As Range
    On Error GoTo exit_proc
    Set rChk = Range(Cells(2, 15), Cells(750, 15)).SpecialCells(xlCellTypeConstants)

    For Each rCl In rChk
        If rCl.Value = 1 Then
            If rDel Is Nothing Then
                Set rDel = rCl.Offset(0, -1)
            Else: Set rDel = Union(rDel, rCl.Offset(0, -1))
            End If
            rDel.Value = ""
        End If
    Next rCl
    Exit Sub
exit_proc:
    MsgBox "No cells found", vbCritical, "End"

End Sub

Hey Marcol
never to late besides its a smart approach .. and must be quicker again

Hi All

SearchAndReplace (Post #12) v check

SearchAndReplace is Faster

SearchAndReplace: 0.1270 49
check: 0.5652 99
Diff: 0.4382 50 Seconds

Checked with Aaron Bloods' Timetrial (add-in)

http://www.xl-logic.com/modules.php?...download&cid=3

Roy: Thank for pointing me to Aarons' add-in

It will be very useful

randell.graybill: Roys error handler would not go amiss added to SearchAndReplace

Regards
Alistair

EDIT: Hold that result!
I checked using dissimilar tables

Roys' method is probably better.

Apologies
Alistair

Hi randell.graybill
Dont forget to change the thread prefix to solved

I think we need clarification on exactly what is required. Are we searching A:J or

The range that would need to be searched and purged would be O2:O750.