Code error
 

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

Code error
 

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" wrote:

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

Code error
 

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

"Dave Ramage" wrote:

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" wrote:

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

Code error
 

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
--
AP


"Tom" a écrit dans le message de
...
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

Code error
 

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" wrote:

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
--
AP


"Tom" a écrit dans le message de
...
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

Code error
 

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
--
AP

"Tom" a écrit dans le message de
...
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" wrote:

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
--
AP


"Tom" a écrit dans le message de
...
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

Code error
 

Ardus,

Thanks for the help.

Lengthy? How long did it take to run?

"Ardus Petus" wrote:

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
--
AP

"Tom" a écrit dans le message de
...
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" wrote:

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
--
AP


"Tom" a écrit dans le message de
...
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

Code error
 

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,
--
AP

"Tom" a écrit dans le message de
...
Ardus,

Thanks for the help.

Lengthy? How long did it take to run?