PDA

View Full Version : Look For and delete



viomman
10-27-2009, 10:22 AM
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

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

xld
10-27-2009, 10:55 AM
I would just filter column K for the three values and delete any visible rows thereafter.

lucas
10-27-2009, 11:05 AM
One way you might try:
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


demo attached.

viomman
10-27-2009, 11:23 AM
Thanks dude that is what i was looking for!!

lucas
10-27-2009, 11:50 AM
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:

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

RolfJ
10-29-2009, 10:00 AM
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