Snailspace Macro Needs Rejuvenation....Anyone?

  • Thread starter Thread starter aircraft_model VBA
  • Start date Start date
A

aircraft_model VBA

Presented below is a macro called cleandata that runs at snailspace!!.

I would like 2 changes to this slow macro:

1. Change the reference of the worksheet from the name (in this case =
new) to simply active worksheet, so that it is not name specific.

2. Speed it up so that it works faster.


Sub Cleandata()
Dim r As Long
Application.ScreenUpdating = False
With Worksheets("new")
For r = .UsedRange.Rows.Count To 1 Step -1
If .Cells(r, "K").Value = "0" Then
.Rows(r).Delete
End If
Next
End With
For Each c In [E1:E35000]
Select Case c.Offset(0, 5).Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
c.Value = c.Value & IIf(Right(c.Text, 1) <> "E", "E", "")
End Select
Next c
Application.ScreenUpdating = True
End Sub

If you have some suggested improvements not mentioned above, please feel
free to make them to the modified code.

As always, thanks in advance to the great excel speedsters!!
 
What I normally do to speed up my macros is to turn off autocalculation. You
can do this via Tools and Option , if you record a macro while doing it you
get the code , while still recording a macro turn it back on and paste the
code before and after your own VBA code.

Macroman
 
Oh and to run the code on the current sheet use this syntax

shtName = activesheet.name
and replace "new" with shtName

Macroman
Macroman said:
What I normally do to speed up my macros is to turn off autocalculation. You
can do this via Tools and Option , if you record a macro while doing it you
get the code , while still recording a macro turn it back on and paste the
code before and after your own VBA code.

Macroman


aircraft_model VBA said:
Presented below is a macro called cleandata that runs at snailspace!!.

I would like 2 changes to this slow macro:

1. Change the reference of the worksheet from the name (in this case =
new) to simply active worksheet, so that it is not name specific.

2. Speed it up so that it works faster.


Sub Cleandata()
Dim r As Long
Application.ScreenUpdating = False
With Worksheets("new")
For r = .UsedRange.Rows.Count To 1 Step -1
If .Cells(r, "K").Value = "0" Then
.Rows(r).Delete
End If
Next
End With
For Each c In [E1:E35000]
Select Case c.Offset(0, 5).Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
c.Value = c.Value & IIf(Right(c.Text, 1) <> "E", "E", "")
End Select
Next c
Application.ScreenUpdating = True
End Sub

If you have some suggested improvements not mentioned above, please feel
free to make them to the modified code.

As always, thanks in advance to the great excel speedsters!!
Click to expand...
Click to expand...
 
aircraft_model VBA,

In your 'For Each c In [E1:E35000] a cell is selected and then the offset
has to be calculated 35000 times.

If you start in Column J then you avoid the offset calculation 35000 times.
You will only need it if the CaseIs statement is true.

For Each c In [J1:J35000]
Select Case c.Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
c.Offset(0, -5).Value = c.Offset(0, -5).Value &
IIf(Right(c.Offset(0, -5).Text, 1) <> "E", "E", "")
End Select
Next c

That should speed it up a little.

Do While loops are quicker than For Next loops so you could try

Private Sub test()
Dim mycounter As Double
Dim c As Range
Dim d As Range
mycounter = 1

Do While mycounter < 35001
Set c = Range("J" & mycounter)
Select Case c.Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
Set d = Range("E" & mycounter)
d.Value = d.Value & IIf(Right(d.Text, 1) <> "E", "E", "")
End Select
mycounter = mycounter + 1
Loop

End Sub

HTH
Henry
 
I tried what you said, still no improvement?? Any other revolutionary
ideas??

Thanks.
 
Henry,

Are you doing 35,000 individual reads and writes??
IMHO that is the "Snailspace" problem.

My thoughts:

Read the database list into an array, manipulate the array variables, and
write the whole array (or the applicable column) back to the sheet. Now, I
think that you may need a fair bit of RAM to handle 35000 rows if there are
many columns, but even if you run the operation in 5 or 10 segments it will
be MUCH faster.

The following, for example, runs in under a second on XL2000. I tried a
single read/single write per cell, and that would run in 30 to 60 seconds.
Pretty good improvement?

Sub test()
trange = Sheets("Sheet1").Range(Cells(1, 1), Cells(35000, 2))
'create 2D array

For i = 1 To 35000
For j = 1 To 2
trange(i, j) = trange(i, j) + 1
'calculate values
Next j
Next i
Sheet("Sheets1").Range(Cells(1, 1), Cells(35000, 2)).Value = trange
'write array to range

End Sub

(Haven't bothered with lots of good Dim statements or range definitions, as
I usually would, for this test)
hope this speeds up things.

Alex J

Henry said:
aircraft_model VBA,

In your 'For Each c In [E1:E35000] a cell is selected and then the offset
has to be calculated 35000 times.

If you start in Column J then you avoid the offset calculation 35000 times.
You will only need it if the CaseIs statement is true.

For Each c In [J1:J35000]
Select Case c.Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
c.Offset(0, -5).Value = c.Offset(0, -5).Value &
IIf(Right(c.Offset(0, -5).Text, 1) <> "E", "E", "")
End Select
Next c

That should speed it up a little.

Do While loops are quicker than For Next loops so you could try

Private Sub test()
Dim mycounter As Double
Dim c As Range
Dim d As Range
mycounter = 1

Do While mycounter < 35001
Set c = Range("J" & mycounter)
Select Case c.Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
Set d = Range("E" & mycounter)
d.Value = d.Value & IIf(Right(d.Text, 1) <> "E", "E", "")
End Select
mycounter = mycounter + 1
Loop

End Sub

HTH
Henry


aircraft_model VBA said:
Presented below is a macro called cleandata that runs at snailspace!!.

I would like 2 changes to this slow macro:

1. Change the reference of the worksheet from the name (in this case =
new) to simply active worksheet, so that it is not name specific.

2. Speed it up so that it works faster.


Sub Cleandata()
Dim r As Long
Application.ScreenUpdating = False
With Worksheets("new")
For r = .UsedRange.Rows.Count To 1 Step -1
If .Cells(r, "K").Value = "0" Then
.Rows(r).Delete
End If
Next
End With
For Each c In [E1:E35000]
Select Case c.Offset(0, 5).Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
c.Value = c.Value & IIf(Right(c.Text, 1) <> "E", "E", "")
End Select
Next c
Application.ScreenUpdating = True
End Sub

If you have some suggested improvements not mentioned above, please feel
free to make them to the modified code.

As always, thanks in advance to the great excel speedsters!!
Click to expand...
Click to expand...
 
There is a marginal improvement but the problem lies with a segment or
part of the macro code as presented below:
------------------
Dim r As Long
Application.ScreenUpdating = False
shtname = ActiveSheet.Name
With Worksheets(shtname)
For r = .UsedRange.Rows.Count To 1 Step -1
If .Cells(r, "K").Value = "0" Then
.Rows(r).Delete
End If
Next
End With
------------------

Can the code above be optimally meshed" or merged into the macro for
maximum efficiency, remains the question?

Presented below is the macro I presently use:

Sub test()
Dim r As Long
Application.ScreenUpdating = False
shtname = ActiveSheet.Name
With Worksheets(shtname)
For r = .UsedRange.Rows.Count To 1 Step -1
If .Cells(r, "K").Value = "0" Then
.Rows(r).Delete
End If
Next
End With
Dim mycounter As Double
Dim c As Range
Dim d As Range
mycounter = 1

Do While mycounter < 35001
Set c = Range("J" & mycounter)
Select Case c.Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
Set d = Range("E" & mycounter)
d.Value = d.Value & IIf(Right(d.Text, 1) <> "E", "E", "")
End Select
mycounter = mycounter + 1
Loop
Application.ScreenUpdating = True
End Sub


Please respond. Appreciate everyone's help.

Thanks.
 
adidas,
You can try creating a union of all the rows to delete, and then delete just
1 time. The trick is to sort or filter all the "0" rows into a single
contiguous range, and then execute a single delete command. I am not sure if
your data can tolerate sorting to achieve this. If you want to use the
filter, there is a way to select just the result of a filter using "Special
Cells" which was posted recently, but I am not sure where it is right now. I
have not done that part before personally.

Alex
 
Can we use something along these lines? as a start...

Rows(Range("K1:K35000")).Delete

Could someone please help.
Thanks.
 
Hi,
I would like 2 changes to this slow macro:

1. Change the reference of the worksheet from the name (in this case =
new) to simply active worksheet, so that it is not name specific.
Click to expand...

Use ActiveSheet instead of Worksheets("new")
2. Speed it up so that it works faster.

Sub Cleandata()
Dim r As Long
Application.ScreenUpdating = False
With Worksheets("new")
For r = .UsedRange.Rows.Count To 1 Step -1
If .Cells(r, "K").Value = "0" Then
.Rows(r).Delete
End If
Next
End With
Click to expand...

A faster way maybe to add an extra column and put a zero or 1 in it
depending on whether the row is to be deleted, then sort by this column,
which puts all the 'to be deleted' rows at the bottom that you can
delete in one go. The problem with doing this is that the sort may not
preserve defined names etc. It typically works well in a database-style
block of data.
For Each c In [E1:E35000]
Select Case c.Offset(0, 5).Text
Case Is = "CRJ", "EM2", "ER3", "ER4", "ERD", "ERJ"
c.Value = c.Value & IIf(Right(c.Text, 1) <> "E", "E", "")
End Select
Next c
Click to expand...

Again, use a separate column to do the additional using a worksheet
formula, copy it and paste special > Values over the original.

Regards

Stephen Bullen
Microsoft MVP - Excel
www.BMSLtd.co.uk
 
Back
Top