Inconsistency in Macro Speed

M

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("D7:D1250"), 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("D6:D1250").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
 
P

Per Jessen

Hi

This should do it:

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D7:D1250"), 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
 
J

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("D7:D1250"), 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
 
M

Monk

Thanks Per this works great.

Per Jessen said:
Hi

This should do it:

Dim Rng As Range, ix As Long
Set Rng = Intersect(Range("D7:D1250"), 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
 
M

Monk

Thanks Joel.

Joel said:
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("D7:D1250"), 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
 
M

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
 
P

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
 

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

Top