Code error

[Tom]

I am having a proble with the following code. It seems to stop at the second
from last <End if> and I don't know why?

TFTH,
Tom

Sub Archive()
Dim iLastRow1 As Long
Dim aLastRow As Long
Dim i As Integer
Dim j As Integer
Dim rw As Long, iCol As Integer

'Determine last row in each activity sheet with a "time back"

iLastRow1 = Sheets("Order Pick").Cells(Rows.Count, "AU").End(xlUp).Row
aLastRow = Sheets("Daily Archive").Cells(Rows.Count, "A").End(xlUp).Row + 1

Application.ScreenUpdating = False

'////////// ORDER PICK ////////////
' Cut and paste each row with a "time back" into the load truck file

For i = iLastRow1 To 24 Step -1
With Sheets("Order Pick").Cells(i, "AU")
If .Value <> "" Then
.EntireRow.Cut Sheets("Daily Archive").Cells(aLastRow, "A")
End If
End With
aLastRow = aLastRow + 1
Next i

' Erase empty rows from each activity sheet


For rw = Sheets("Order Pick").UsedRange.Rows.Count To 24 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column = 1 Then
Rows(rw).Delete
End If
End If
Next




' Erase empty rows from daily archive sheet

Sheets("Daily Archive").Select
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

 

[Dave Ramage]

Do you get an error message, or is there a syntax check error etc.- what do
you mean by 'stop'?

(Always a good idea to provide this sort of information in your original
post- makes it easier to help you)

Cheers,
Dave

 

[Tom]

Sorry as I am very basic in my codes and thinking.... Basically, when I run
the code it seems to run forever. I have to hit <esc> to stop the code and
when I do stop it Debug takes me to the second to last <End if> statement.

HTH,
Tom

 

[Ardus Petus]

If you enter an endless loop, that coul be caused by iLastRow1 being smaller
than 24.

Please check, or send me a copy of your workbook

HTH

 

[Tom]

I forwarded you a copy of the spreadsheet to your e-mail address. Have you
had any luck with the code?
TFTH,
Tom

 

[Ardus Petus]

The code is OK, only extremely lengthy while deleting rows from sheet "Order
Pick"'s UsedRange.

I will think over some way to make it faster.

HIH

 

[Tom]

Ardus,

Thanks for the help.

Lengthy? How long did it take to run?

 

[Ardus Petus]

The lengthy (not infinite) part of code is the following:

' Erase empty rows from each activity sheet

For rw = Sheets("Order Pick").UsedRange.Rows.Count To 24 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column = 1 Then
Rows(rw).Delete
End If
End If
Next

If yo add MsgBox Sheets("Order Pick").UsedRange.Rows.Count
before that part of code, yo see that UsedRange is very big : 2316 rows.

The Rows(rw).Delete instruction is slow (almost 1 sec per line => 2316-24 =
40 min. approx.

If you comment out de Rows(rw).Delete line, the whole macro runs within
seconds.

-----------
Another point:

I noticed your Order Pick sheet is not empty, but contains no line to be
archived (col AU).
Do you happen to have an earlier version of your file?

HIH,