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("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
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