Help on cleaning / speeding up code

[Chris Salcedo]

Hi guys,

I have the following code that cleans up a text imported file.
All it does is get rid of lines that contain the find criteria.
This works great but its slow (62k lines in the file and lots of
instances of the crap lines)


Sub DeleteUnwantedLines()
Application.ScreenUpdating = False
Dim lastcell As Range, FoundCell As Range


Do
Set FoundCell = Cells.Find(What:="severn", LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Range(FoundCell.Address).EntireRow.Delete
Else
Exit Do
End If
Loop
Do
Set FoundCell = Cells.Find(What:="Cost", LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Range(FoundCell.Address).EntireRow.Delete
Else
Exit Do
End If
Loop
Do
Set FoundCell = Cells.Find(What:="----", LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Range(FoundCell.Address).EntireRow.Delete
Else
Exit Do
End If
Loop
Do
Set FoundCell = Cells.Find(What:="Actual", LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Range(FoundCell.Address).EntireRow.Delete
Else
Exit Do
End If
Loop
Do
Set FoundCell = Cells.Find(What:="ERP ", LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Range(FoundCell.Address).EntireRow.Delete
Else
Exit Do
End If
Loop

Call DeleteUnused
Application.ScreenUpdating = True
End Sub

Anyone have any ideas how to do this faster ???


I have another piece of ugly code that also works but is slow.
This checks to see if all values of row x columns B-G are 0 and if so
delete the entire row.

Sub Delete0ValueRows()

ris = mrows
Application.ScreenUpdating = False
Do While ris <> 0
If Range("B" & ris).Value = "0" And Range("C" & ris).Value =
"0" And _
Range("D" & ris).Value = "0" And Range("E" & ris).Value = "0"
And _
Range("F" & ris).Value = "0" And Range("G" & ris).Value = "0"
Then
Range("A" & ris).EntireRow.Delete
End If
ris = ris - 1
Loop
Call DeleteUnused
Application.ScreenUpdating = True
End Sub

Thanks for the help...

 

[Jim Cone]

Chris,
See if this is any faster.
Jim Cone
San Francisco, USA

'---------------------------
Sub Delete0ValueRows()
Dim mRows As Long
Dim ris As Long

mRows = 1000
ris = mRows
Application.ScreenUpdating = False
Do While ris > 0
If Application.Sum(Range(Cells(ris, 2), Cells(ris, 7))) = 0 Then
Cells(ris, 2).EntireRow.Delete
End If
ris = ris - 1
Loop
'Call DeleteUnused '?
Application.ScreenUpdating = True
End Sub
'-----------------------

"Chris Salcedo" <[email protected]>
wrote in message
Hi guys,

- snip -

I have another piece of ugly code that also works but is slow.
This checks to see if all values of row x columns B-G are 0 and if so
delete the entire row.

Sub Delete0ValueRows()
ris = mrows
Application.ScreenUpdating = False
Do While ris <> 0
If Range("B" & ris).Value = "0" And Range("C" & ris).Value =
"0" And _
Range("D" & ris).Value = "0" And Range("E" & ris).Value = "0"
And _
Range("F" & ris).Value = "0" And Range("G" & ris).Value = "0"
Then
Range("A" & ris).EntireRow.Delete
End If
ris = ris - 1
Loop
Call DeleteUnused
Application.ScreenUpdating = True
End Sub
Thanks for the help...

 

[Guest]

Hi Chris,

Here's a solution (see code below) which I think might be faster for you. I
think one issue with Jim's solution is that summing the cells is different
than testing to see if each cell is zero. (i.e., you could have 1 and -1 in
two cells and the sum would be zero, but you wouldn't want to delete the row.
At least that's how I interpreted your code.)

Hope it helps.

Regards,
James

Sub DeleteZeroValueRows()
'DECLARATIONS
'------------
Dim wks As Worksheet
Dim rng As Range
Dim lngRows As Integer ' This is your "ris" equivalent.
Dim i As Integer

'INITIALIZE
'----------
lngRows = 10 ' Change the value of 10 to your "ris" value.
' Change the name of "Sheet1" below to your worksheet name.
Set wks = ThisWorkbook.Worksheets("Sheet1")

'MAIN BODY
'---------
Application.ScreenUpdating = False
Do While lngRows <> 0
Set rng = wks.Range("B" & lngRows)
For i = 0 To 5
If rng.Offset(0, i).Value <> 0 Then
Exit For
End If
If i = 5 Then
' Columns B through G of the current row ALL have zeros.
' Delete this row.
rng.EntireRow.Delete
End If
Next i
lngRows = lngRows - 1
Loop
'Call DeleteUnused
Application.ScreenUpdating = True
MsgBox "DONE"

'WRAP-UP
'-------
GoSub CleanUp
Exit Sub

'CLEAN-UP
'--------
CleanUp:
Set wks = Nothing
Set rng = Nothing
Return

'ERROR HANDLER
'-------------
ErrHandler:
MsgBox "Error Number: " & Err.Number & vbCrLf & vbCrLf &
Err.Description, _
vbOKOnly + vbInformation, "DeleteZeroValueRows()"
GoSub CleanUp
End Sub