Processor Can't Handle This Deletion Code -- Suggestions to Modify

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am currently using the following code to delete rows in which the specified
columns contain values of 0.

The reason I am writing this macro is because I have a rather massive, and
computation heavy, worksheet that will benefit from being parsed before
saving. The sheet itself is 265 x 2160 and about 21meg.

Anyone have suggestions on how I code execute this deletion without crashing
a computer (personally running a 1.5ghz 512meg Ram system)


Sub Project_Data_Deletion()

'Delete all unused cells from the Plan worksheet

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Sheets("plan").Select
Range("c4:c2163").Select
For i = Selection.Cells.Count To 1 Step -1
If Selection.Cells(i) = 0 Then
Selection.Rows(i).EntireRow.Delete

End If
Next i

Range("f4:f2163").Select
For i = Selection.Cells.Count To 1 Step -1
If Selection.Cells(i) = 0 Then
Selection.Rows(i).EntireRow.Delete

End If
Next i

Range("m4:m2163").Select
For i = Selection.Cells.Count To 1 Step -1
If Selection.Cells(i) = 0 Then
Selection.Rows(i).EntireRow.Delete

End If
Next i


.ScreenUpdating = True

End Sub
 
Sub Project_Data_Deletion()
Dim rng as Range, i as Long
'Delete all unused cells from the Plan worksheet

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Sheets("plan").Select

For i = 2163 To 1 Step -1
If cells(i,"F") = 0 or cells(i,"M") = 0 _
or cells(i,"C") = 0 then
if rng is nothing then
set rng = cells(i,1)
else
set rng = union(rng,cells(i,1))
end if
end if
Next i
if not rng is nothing then
rng.EntireRow.Delete
end if

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
 
Used your code. After 15 minutes, I broke the cycle. Is it possible that I
need to break up the worksheet into smaller portions to delete at a time? It
seems like this is too much at once, perhaps.
 
Mark,

The fastest way to do this is to sort the rows based on your criteria, using
a helper column of formulas, and then delete them as a block, all at once.
Try the macro below, which should speed things up considerably.

HTH,
Bernie
MS Excel MVP

Sub BlastZero()
Dim myRows As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Range("A1").EntireColumn.Insert
Range("A4").FormulaR1C1 = _
"=IF(OR(RC[3]=0,RC[6]=0,RC[13]=0), " & _
"""Trash"",""Keep"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A4").Copy Range("A4:A" & myRows)
With Range(Range("A4"), Range("A4").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A:A").SpecialCells(xlCellTypeBlanks).Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A4")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End With
 
I filled 2160 rows and every column (256) in those rows with a formula

=Trunc(rand()*20)

rand is a volatile function, but it obviously doesn't create dependencies.

I ran the code.

It took 39.56 seconds to delete 334 rows.

I altered the formula in C so more rows would be deleted and ran it again.

It took 66.75 seconds to delete 1229 rows (more than half)

all the code was instantaneous except the single command

rng.EntireRow.Delete

Since that deletes all the appropriate rows at once, there is not much you
can do to get inside that.

Nonetheless, my times were magnitudes faster than yours. Windows XP
Professional, Excel 2003, on a 2.8 Ghz processor
 
Unfortunately the worksheet is being used as a functional model with clear
data entry points for users and not as a spreadsheet, so any sorting would
completely rearrange and confuse the current organization -- rearranging that
would be very hard to resort.

Bernie Deitrick said:
Mark,

The fastest way to do this is to sort the rows based on your criteria, using
a helper column of formulas, and then delete them as a block, all at once.
Try the macro below, which should speed things up considerably.

HTH,
Bernie
MS Excel MVP

Sub BlastZero()
Dim myRows As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Range("A1").EntireColumn.Insert
Range("A4").FormulaR1C1 = _
"=IF(OR(RC[3]=0,RC[6]=0,RC[13]=0), " & _
"""Trash"",""Keep"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A4").Copy Range("A4:A" & myRows)
With Range(Range("A4"), Range("A4").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A:A").SpecialCells(xlCellTypeBlanks).Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A4")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End With


Mark said:
Used your code. After 15 minutes, I broke the cycle. Is it possible that I
need to break up the worksheet into smaller portions to delete at a time? It
seems like this is too much at once, perhaps.
Click to expand...
Click to expand...
 
Mark,

The sort is based on a single column, so the order of the remaining rows is
actually preserved, and your sheet will suffer no ill effects.

Of course, try it on a copy of your file first....

HTH,
Bernie
MS Excel MVP

Mark said:
Unfortunately the worksheet is being used as a functional model with clear
data entry points for users and not as a spreadsheet, so any sorting would
completely rearrange and confuse the current organization -- rearranging that
would be very hard to resort.

Bernie Deitrick said:
Mark,

The fastest way to do this is to sort the rows based on your criteria, using
a helper column of formulas, and then delete them as a block, all at once.
Try the macro below, which should speed things up considerably.

HTH,
Bernie
MS Excel MVP

Sub BlastZero()
Dim myRows As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Range("A1").EntireColumn.Insert
Range("A4").FormulaR1C1 = _
"=IF(OR(RC[3]=0,RC[6]=0,RC[13]=0), " & _
"""Trash"",""Keep"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A4").Copy Range("A4:A" & myRows)
With Range(Range("A4"), Range("A4").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A:A").SpecialCells(xlCellTypeBlanks).Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A4")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End With


Mark said:
Used your code. After 15 minutes, I broke the cycle. Is it possible
Click to expand...
that
I
need to break up the worksheet into smaller portions to delete at a
Click to expand...
time?
It
seems like this is too much at once, perhaps.

:

Sub Project_Data_Deletion()
Dim rng as Range, i as Long
'Delete all unused cells from the Plan worksheet

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Sheets("plan").Select

For i = 2163 To 1 Step -1
If cells(i,"F") = 0 or cells(i,"M") = 0 _
or cells(i,"C") = 0 then
if rng is nothing then
set rng = cells(i,1)
else
set rng = union(rng,cells(i,1))
end if
end if
Next i
if not rng is nothing then
rng.EntireRow.Delete
end if

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
Click to expand...
Click to expand...
Click to expand...
 
I think some of the issue is around exactly how complicated the code in some
of the cells is (not complicated, but extensively conditional). The
following is representative of the type of function inserted in most cells.
As you can see, the multiple If's as well as constant references to other
worksheets takes its toll.

IF(AND(I544<=DATE('Setup Form'!O$11,'Setup Form'!N$11,1),I544>=DATE('Setup
Form'!M$11,'Setup Form'!L$11,1)),'Setup Form'!J$11,IF(AND(I544<=DATE('Setup
Form'!O$12,'Setup Form'!N$12,1),I544>=DATE('Setup Form'!M$12,'Setup
Form'!L$12,1)),'Setup Form'!J$12,IF(AND(I544<=DATE('Setup Form'!O$13,'Setup
Form'!N$13,1),I544>=DATE('Setup Form'!M$13,'Setup Form'!L$13,1)),'Setup
Form'!J$13,IF(AND(I544<=DATE('Setup Form'!O$14,'Setup
Form'!N$14,1),I544>=DATE('Setup Form'!M$14,'Setup Form'!L$14,1)),'Setup
Form'!J$14,IF(AND(I544<=DATE('Setup Form'!O$15,'Setup
Form'!N$15,1),I544>=DATE('Setup Form'!M$15,'Setup Form'!L$15,1)),'Setup
Form'!J$15,IF(AND(I544<=DATE('Setup Form'!O$16,'Setup
Form'!N$16,1),I544>=DATE('Setup Form'!M$16,'Setup Form'!L$16,1)),'Setup
Form'!J$16,IF(I544>=DATE('Setup Form'!M$17,'Setup Form'!L$17,1),'Setup
Form'!J$17,0)))))))
 
Oops,

With the correction in the code (to actually calculate the formula - see
below), the same formulas as Tom's test (except one column less, to allow
the column insertion) took about 5 seconds.

HTH,
Bernie
MS Excel MVP

Sub BlastZero()
Dim myRows As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Range("A1").EntireColumn.Insert
Range("A4").FormulaR1C1 = _
"=IF(OR(RC[3]=0,RC[6]=0,RC[13]=0), " & _
"""Trash"",""Keep"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A4").Copy Range("A4:A" & myRows)
Application.Calculate
With Range(Range("A4"), Range("A4").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A:A").SpecialCells(xlCellTypeBlanks).Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A4")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub


Mark said:
Unfortunately the worksheet is being used as a functional model with clear
data entry points for users and not as a spreadsheet, so any sorting would
completely rearrange and confuse the current organization -- rearranging that
would be very hard to resort.

Bernie Deitrick said:
Mark,

The fastest way to do this is to sort the rows based on your criteria, using
a helper column of formulas, and then delete them as a block, all at once.
Try the macro below, which should speed things up considerably.

HTH,
Bernie
MS Excel MVP

Sub BlastZero()
Dim myRows As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Range("A1").EntireColumn.Insert
Range("A4").FormulaR1C1 = _
"=IF(OR(RC[3]=0,RC[6]=0,RC[13]=0), " & _
"""Trash"",""Keep"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A4").Copy Range("A4:A" & myRows)
With Range(Range("A4"), Range("A4").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Range("A:A").SpecialCells(xlCellTypeBlanks).Value = "Keep"
Cells.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A4")).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End With


Mark said:
Used your code. After 15 minutes, I broke the cycle. Is it possible
Click to expand...
that
I
need to break up the worksheet into smaller portions to delete at a
Click to expand...
time?
It
seems like this is too much at once, perhaps.

:

Sub Project_Data_Deletion()
Dim rng as Range, i as Long
'Delete all unused cells from the Plan worksheet

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False

Sheets("plan").Select

For i = 2163 To 1 Step -1
If cells(i,"F") = 0 or cells(i,"M") = 0 _
or cells(i,"C") = 0 then
if rng is nothing then
set rng = cells(i,1)
else
set rng = union(rng,cells(i,1))
end if
end if
Next i
if not rng is nothing then
rng.EntireRow.Delete
end if

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Code to mimic vlookup 1
delete row if no data, non-contiguous range problem 12
Run Macro on All Worksheets in a workbook 7
Too much data for this code? 4
Problem with deleting blank rows or last row 4
Define Range in Deleting Empty Rows 1
deleting blank rows for up to 60000 rows of data 3
range or string or long type 16

Back
Top