Inconsistency in Macro Speed

[Monk]

Hi

I am experiencing some inconsistency with the speed execution of one of my
macros. Essentially I am trying to delete blank rows in the range d7:d1250.
In most cases the macro runs quickly enough, usually less than 10 seconds
however from time to time the macro will stall and it will take about 3
minutes to complete. If I press Esc the debug shows it is stuck in the
following section. If anyone can suggest why this is occuring or can provide
a better code it would be appreciated.

The code provided below is only a small part of the entire macro but I
believe this is the area causing the problem.

Thanks

Monk

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D71250"), ActiveSheet.UsedRange)
For ix = Rng.Count To 1 Step -1
If Trim(Application.WorksheetFunction.Substitute(Rng.Item(ix).Text,
Chr(160), Chr(32))) = "" Then
Rng.Item(ix).EntireRow.Delete
End If
Next
Range("D61250").Select
Const StartRow As Long = 1 'Row to Start looking at
Dim StopRow As Long
Dim Col As Long
Col = ActiveCell.Column
StopRow = Cells(Rows.Count, Col).End(xlUp).Row
Dim cnt As Long
For cnt = StopRow To StartRow Step -1
If Not IsEmpty(Cells(cnt, Col)) Then
If IsNumeric(Cells(cnt, Col)) Then
If Cells(cnt, Col) = 0 Then Rows(cnt).Delete
End If
End If
Next cnt

 

[Per Jessen]

Hi

This should do it:

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D71250"), ActiveSheet.UsedRange)
Rng.Replace Chr(160), Chr(32), xlValue

For ix = Rng.Count To 1 Step -1
If Trim(Rng.Item(ix).Text) = "" Or Rng.Item(ix).Value = 0 Then
Rng.Item(ix).EntireRow.Delete
End If
Next

Regards,
Per

 

[Joel]

Monk: Deleteing rows is always slow. I've found when I have to delete a lot
or rows the quickest method is to use an auxilary column to indicate which
rows need to be deleted. I usually just place an X in column IV. Then I
sort in column IV in Descending order which will move the X's to the top of
the worksheet. I then delete all the rows in one step. Here are my changes

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D71250"), ActiveSheet.UsedRange)
Rng.Replace Chr(160), Chr(32), xlValue

For ix = Rng.Count To 1 Step -1
If Trim(Rng.Item(ix).Text) = "" Or Rng.Item(ix).Value = 0 Then
Cells(Rng.Item(ix).Row, "IV") = "X"
End If
Next

Rows("7:1250").Sort _
key1:=Range("IV7"), _
order1:=xlDescending, _
header:=xlNo

LastRow = Range("IV" & Rows.Count).End(xlUp).Row
If Range("IV7") = "X" Then
Rows("7:" & LastRow).Delete
End If

 

[Monk]

Thanks Per this works great.

Hi

This should do it:

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D71250"), ActiveSheet.UsedRange)
Rng.Replace Chr(160), Chr(32), xlValue

For ix = Rng.Count To 1 Step -1
If Trim(Rng.Item(ix).Text) = "" Or Rng.Item(ix).Value = 0 Then
Rng.Item(ix).EntireRow.Delete
End If
Next

Regards,
Per

 

[Monk]

Thanks Joel.

Monk: Deleteing rows is always slow. I've found when I have to delete a lot
or rows the quickest method is to use an auxilary column to indicate which
rows need to be deleted. I usually just place an X in column IV. Then I
sort in column IV in Descending order which will move the X's to the top of
the worksheet. I then delete all the rows in one step. Here are my changes

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D71250"), ActiveSheet.UsedRange)
Rng.Replace Chr(160), Chr(32), xlValue

For ix = Rng.Count To 1 Step -1
If Trim(Rng.Item(ix).Text) = "" Or Rng.Item(ix).Value = 0 Then
Cells(Rng.Item(ix).Row, "IV") = "X"
End If
Next

Rows("7:1250").Sort _
key1:=Range("IV7"), _
order1:=xlDescending, _
header:=xlNo

LastRow = Range("IV" & Rows.Count).End(xlUp).Row
If Range("IV7") = "X" Then
Rows("7:" & LastRow).Delete
End If

 

[Monk]

Hi Per

Some of our people in the office are still using Excel97...don't get me
started.

Anyway, the code below is deleting rows that has text in it for those users
(it leaves rows with numeric data but will delete rows with text). Works fine
on 2003 and later versions. Are you able to advise a variation of the code
that would work for the 97 users as well?

Thanks in advance

 

[Per Jessen]

Hi Monk

Thanks for your reply.

I'm not sure, but assuming that your original code worked as desired
in Excel97 this should do it:

For ix = Rng.Count To 1 Step -1
If Trim(Rng.Item(ix).Text) = "" Or Rng.Item(ix).Value = 0 Then
If Not IsEmpty(Rng.Item(ix)) Then Rng.Item
(ix).EntireRow.Delete
End If
Next

Regards,
Per