Look For and delete

[viomman]

Is there a more efficent way to address this code?
I am trying to have excel look for specfic items in cels and delete the entire row out of the workbook
My loop is not working either

[vba]Sub DeleteDocCode()
Dim rng As Range 'Dimension of the first criteria'
Dim rngEFT As Range
Dim rngPREXP As Range
Set rng = Range("K1:K6000").Find(What:="AD", LookIn:=xlValues, Lookat:=xlValue, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
Set rngEFT = Range("K1:K6000").Find(What:="EFT", LookIn:=xlValues, Lookat:=xlValue, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
Set rngPREXP = Range("K1:K6000").Find(What:="PREXP", LookIn:=xlValues, Lookat:=xlValue, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
Do
If rng Is Nothing Then
MsgBox "Data Not Found"
Else
rng.Offset(0, -10).EntireRow.Select 'offset to the left ten cells'
Selection.Delete Shift:=xlUp
End If
If rngEFT Is Nothing Then
MsgBox "Data Not Found"
Else
rngEFT.Offset(0, -10).EntireRow.Select
Selection.Delete Shift:=xlUp
End If
If rngPREXP Is Nothing Then
MsgBox "Data Not Found"
Else
rngPREXP.Offset(0, -10).EntireRow.Select
Selection.Delete Shift:=xlUp
End If
Loop Until IsEmpty(ActiveCell.Offset(0, -10))[/vba]

[Bob Phillips]

I would just filter column K for the three values and delete any visible rows thereafter.

[lucas]

One way you might try:
[VBA]Option Explicit
'delete rows for multiple criteria, must select cell in target row.
'or use the Range("K6").Select to select the column
Sub DeleteMultipleStringRows()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("K6").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "PREXP"
If test = True Then Cells(x, col).EntireRow.Delete
Next

For x = lastrow To 1 Step -1

test = Cells(x, col).Text Like "EFT"
If test = True Then Cells(x, col).EntireRow.Delete
Next

For x = lastrow To 1 Step -1

test = Cells(x, col).Text Like "AD"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub
[/VBA]

demo attached.

[viomman]

Thanks dude that is what i was looking for!!

[lucas]

Bob's suggestion of using a filter may be faster with lots of data. Maybe something like this is you need to use code. Gleaned from following Bob(XLD) around the forum:

[VBA]Public Sub DeleteRowsUsingAutofilter()
'-----------------------------------------------------------------
' Column K is number 11
Const TestColumn As Long = 11
Dim cRows As Long

'first, count the rows to operate on
cRows = Cells(Rows.Count, TestColumn).End(xlUp).Row

'finally, apply the autofilter for al matching cells
Columns(TestColumn).AutoFilter Field:=1, Criteria1:="PREXP", Operator:=xlAnd

'we now have only matching rows visible, so we can
'delete these matching rows
With Cells(2, TestColumn).Resize(cRows - 1)
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With

Columns(TestColumn).AutoFilter Field:=1, Criteria1:="EFT", Operator:=xlAnd

'we now have only matching rows visible, so we can
'delete these matching rows
With Cells(2, TestColumn).Resize(cRows - 1)
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With

Columns(TestColumn).AutoFilter Field:=1, Criteria1:="AD", Operator:=xlAnd

'we now have only matching rows visible, so we can
'delete these matching rows
With Cells(2, TestColumn).Resize(cRows - 1)
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Columns(TestColumn).AutoFilter
End Sub
[/VBA]

[RolfJ]

Anytime you delete a row from a worksheet you take a SIGNIFICANT performance hit. This obviously becomes an issues when you have lots of rows to delete.

I duplicated the contents in lucas' original workbook down until I reached row 6000. When I then ran his original code on my laptop it took almost 50 secs to complete. His modified code using autofiltering still took over 5 secs. That may be considered acceptable, but if you were to take the whole process into memory and were to access the worksheet only twice, first to read the data and finally, after deleting the rows in memory, to paste the modified data back to the worksheet, you could obtain an enormous performance acceleration. The code below took on my laptop less than 0.2 secs to complete. That's a 250x(!!!) improvement over the original code, and still a 25x improvement over the code with autofiltering! Give it try.

 
Sub DeleteMultipleStringRows_InMemory()
 
    If ActiveSheet.UsedRange.Cells.Count = 1 Then Exit Sub
 
    Dim targetColumn As Long
    targetColumn = Columns("K").Column - ActiveSheet.UsedRange.Cells(1, 1).Column + 1
 
    If targetColumn < 1 Then
        MsgBox ("Column K is empty")
        Exit Sub
    End If
 
    Dim startTime As Double
    startTime = Timer
    Dim db As Variant
    db = ActiveSheet.UsedRange
 
    Dim rToDelete() As Long
    ReDim rToDelete(0)
 
    Dim iRow As Long
    For iRow = 1 To UBound(db, 1)
        If db(iRow, targetColumn) Like "PREXP" _
            Or db(iRow, targetColumn) Like "EFT" _
            Or db(iRow, targetColumn) Like "AD" _
        Then
            ReDim Preserve rToDelete(UBound(rToDelete, 1) + 1)
            rToDelete(UBound(rToDelete, 1)) = iRow
        End If
    Next iRow
 
    db = DeleteMultipleRowsFromArray(db, rToDelete())
 
    Dim targetRange As Range
    Set targetRange = Range(ActiveSheet.UsedRange.Cells(1, 1), ActiveSheet.UsedRange.Cells(UBound(db, 1), _
UBound(db, 2)))
    targetRange.Select
    ActiveSheet.UsedRange.Clear
    targetRange = db
 
    Debug.Print "Elaped time: " & Timer - startTime & "sec"
 
End Sub
 
Function DeleteMultipleRowsFromArray(a As Variant, rowsToDelete() As Long) As Variant
    'rowsToDelete must contain the numbers of the rows to delete
    'in increasing order
    Dim n() As String
    ReDim n(1 To UBound(a, 1) - UBound(rowsToDelete, 1), 1 To UBound(a, 2))
    Dim iRowOriginal
    Dim iRowToDelete
    iRowToDelete = 1
    Dim iRowNew, iCol As Long
    iRowNew = 1
    For iRowOriginal = 1 To UBound(a, 1)
        If iRowOriginal = rowsToDelete(iRowToDelete) Then
            If iRowToDelete < UBound(rowsToDelete) Then iRowToDelete = iRowToDelete + 1
        Else
            For iCol = 1 To UBound(a, 2)
                n(iRowNew, iCol) = a(iRowOriginal, iCol)
            Next iCol
            iRowNew = iRowNew + 1
        End If
    Next iRowOriginal
 
    DeleteMultipleRowsFromArray = n
 
End Function

Hope this helped,
Rolf