ExcelBanter - Code Improvements

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Code Improvements (https://www.excelbanter.com/excel-programming/447223-re-code-improvements.html)

Code Improvements

Hi all.
I need a way to improve the code shown below.
The code first checks if time in column P is between the namedranges
ShipmentDate_StartValue & ShipmentDate_EndValue, marks the row del or keep.
Then loops back through this and deletes cols A through Q if marked del.

Sheet3.Activate
Range("Q2").Select
' Removes extra rows not within start & end range
Do While Not IsEmpty(ActiveCell.Offset(0, -1))
ActiveCell.FormulaR1C1 = _
"=IF(OR('Dollies -
Shipment'!RC[-1]<ShipmentDate_StartValue,'Dollies -
Shipment'!RC[-1]ShipmentDate_EndValue),""Del"",""Keep"")"
ActiveCell.Offset(1, 0).Select
Loop
Range("Q2").Select
Do While Not IsEmpty(ActiveCell.Offset(0, -1))
Do While ActiveCell = "Del"
ActiveCell.Offset(0, -16).Range("A1:Q1").Select
Selection.Delete Shift:=xlUp
ActiveCell.Offset(0, 16).Select
Loop
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Range("Q:Q").ClearContents

When I run this using Excel 2003 the code takes approx. 8/9 seconds.
When using Excel 2010 the code runs for nearly 2 minutes.
I cannot see any reason for this delay.

Is there a more efficient way of coding the above.
Our company has now upgraded to Excel 2007 which is the reason for the
change.
Thanks in advance,
edul

Code Improvements

On Tuesday, September 25, 2012 5:02:45 PM UTC-5, milli wrote:
Hi all.

I need a way to improve the code shown below.

The code first checks if time in column P is between the namedranges

ShipmentDate_StartValue & ShipmentDate_EndValue, marks the row del or keep.

Then loops back through this and deletes cols A through Q if marked del.

Sheet3.Activate

Range("Q2").Select

' Removes extra rows not within start & end range

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

ActiveCell.FormulaR1C1 = _

"=IF(OR('Dollies -

Shipment'!RC[-1]<ShipmentDate_StartValue,'Dollies -

Shipment'!RC[-1]ShipmentDate_EndValue),""Del"",""Keep"")"

ActiveCell.Offset(1, 0).Select

Loop

Range("Q2").Select

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

Do While ActiveCell = "Del"

ActiveCell.Offset(0, -16).Range("A1:Q1").Select

Selection.Delete Shift:=xlUp

ActiveCell.Offset(0, 16).Select

Loop

ActiveCell.Offset(1, 0).Select

Loop

ActiveSheet.Range("Q:Q").ClearContents

When I run this using Excel 2003 the code takes approx. 8/9 seconds.

When using Excel 2010 the code runs for nearly 2 minutes.

I cannot see any reason for this delay.

Is there a more efficient way of coding the above.

Our company has now upgraded to Excel 2007 which is the reason for the

change.

Thanks in advance,

edul

Copy this. If not OK send file to dguillett @ gmail.com with a complete explanation and both codes.

Sub DeleteRangeIf_SAS()
Dim i As Long
Application.ScreenUpdating = False
With Sheet3 ' works from anywhere in the workbook
For i = 2 To .Cells(Rows.Count, "p").End(xlUp).Row
If .Cells(i, "Q") = ShipmentDate_StartValue And _
.Cells(i, "Q") < ShipmentDate_endvalue Then _
..Range(Cells(i, "a"), Cells(i, "q")).Delete Shift:=xlUp
Next i
Application.ScreenUpdating = True
End With
columns("q").clear 'question if necessary?
End Sub

Code Improvements

On 25/09/2012 23:38, Don Guillett wrote:
On Tuesday, September 25, 2012 5:02:45 PM UTC-5, milli wrote:
Hi all.

I need a way to improve the code shown below.

The code first checks if time in column P is between the namedranges

ShipmentDate_StartValue & ShipmentDate_EndValue, marks the row del or keep.

Then loops back through this and deletes cols A through Q if marked del.

Sheet3.Activate

Range("Q2").Select

' Removes extra rows not within start & end range

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

ActiveCell.FormulaR1C1 = _

"=IF(OR('Dollies -

Shipment'!RC[-1]<ShipmentDate_StartValue,'Dollies -

Shipment'!RC[-1]ShipmentDate_EndValue),""Del"",""Keep"")"

ActiveCell.Offset(1, 0).Select

Loop

Range("Q2").Select

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

Do While ActiveCell = "Del"

ActiveCell.Offset(0, -16).Range("A1:Q1").Select

Selection.Delete Shift:=xlUp

ActiveCell.Offset(0, 16).Select

Loop

ActiveCell.Offset(1, 0).Select

Loop

ActiveSheet.Range("Q:Q").ClearContents

When I run this using Excel 2003 the code takes approx. 8/9 seconds.

When using Excel 2010 the code runs for nearly 2 minutes.

I cannot see any reason for this delay.

Is there a more efficient way of coding the above.

Our company has now upgraded to Excel 2007 which is the reason for the

change.

Thanks in advance,

edul

Copy this. If not OK send file to dguillett @ gmail.com with a complete explanation and both codes.

Sub DeleteRangeIf_SAS()
Dim i As Long
Application.ScreenUpdating = False
With Sheet3 ' works from anywhere in the workbook
For i = 2 To .Cells(Rows.Count, "p").End(xlUp).Row
If .Cells(i, "Q") = ShipmentDate_StartValue And _
.Cells(i, "Q") < ShipmentDate_endvalue Then _
..Range(Cells(i, "a"), Cells(i, "q")).Delete Shift:=xlUp
Next i
Application.ScreenUpdating = True
End With
columns("q").clear 'question if necessary?
End Sub

Hi Don.
I could not get your code to work for me. I have emailed you with details.

Thanks,
edul

Code Improvements

On Tuesday, September 25, 2012 5:02:45 PM UTC-5, milli wrote:
Hi all.

I need a way to improve the code shown below.

The code first checks if time in column P is between the namedranges

ShipmentDate_StartValue & ShipmentDate_EndValue, marks the row del or keep.

Then loops back through this and deletes cols A through Q if marked del.

Sheet3.Activate

Range("Q2").Select

' Removes extra rows not within start & end range

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

ActiveCell.FormulaR1C1 = _

"=IF(OR('Dollies -

Shipment'!RC[-1]<ShipmentDate_StartValue,'Dollies -

Shipment'!RC[-1]ShipmentDate_EndValue),""Del"",""Keep"")"

ActiveCell.Offset(1, 0).Select

Loop

Range("Q2").Select

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

Do While ActiveCell = "Del"

ActiveCell.Offset(0, -16).Range("A1:Q1").Select

Selection.Delete Shift:=xlUp

ActiveCell.Offset(0, 16).Select

Loop

ActiveCell.Offset(1, 0).Select

Loop

ActiveSheet.Range("Q:Q").ClearContents

When I run this using Excel 2003 the code takes approx. 8/9 seconds.

When using Excel 2010 the code runs for nearly 2 minutes.

I cannot see any reason for this delay.

Is there a more efficient way of coding the above.

Our company has now upgraded to Excel 2007 which is the reason for the

change.

Thanks in advance,

edul

uSub FilterByDateTime()
Dim sd As Double

If IsDate(Range("r1")) Then
sd = Range("s1") '+14 = 2pm
sdDate = DateSerial(Year(sd), Month(sd), Day(sd)) + _
TimeSerial(Hour(sd), Minute(sd), Second(sd))

With ActiveSheet.UsedRange
.AutoFilter Field:=16, Criteria1:="<=" & sd _
, Operator:=xlOr, Criteria2:="" & sd + 1 '+ 1 day
.Offset(1).EntireRow.Delete
.AutoFilter
End With
End If
End Subse this

Code Improvements

On 27/09/2012 15:42, Don Guillett wrote:
On Tuesday, September 25, 2012 5:02:45 PM UTC-5, milli wrote:
Hi all.

I need a way to improve the code shown below.

The code first checks if time in column P is between the namedranges

ShipmentDate_StartValue & ShipmentDate_EndValue, marks the row del or keep.

Then loops back through this and deletes cols A through Q if marked del.

Sheet3.Activate

Range("Q2").Select

' Removes extra rows not within start & end range

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

ActiveCell.FormulaR1C1 = _

"=IF(OR('Dollies -

Shipment'!RC[-1]<ShipmentDate_StartValue,'Dollies -

Shipment'!RC[-1]ShipmentDate_EndValue),""Del"",""Keep"")"

ActiveCell.Offset(1, 0).Select

Loop

Range("Q2").Select

Do While Not IsEmpty(ActiveCell.Offset(0, -1))

Do While ActiveCell = "Del"

ActiveCell.Offset(0, -16).Range("A1:Q1").Select

Selection.Delete Shift:=xlUp

ActiveCell.Offset(0, 16).Select

Loop

ActiveCell.Offset(1, 0).Select

Loop

ActiveSheet.Range("Q:Q").ClearContents

When I run this using Excel 2003 the code takes approx. 8/9 seconds.

When using Excel 2010 the code runs for nearly 2 minutes.

I cannot see any reason for this delay.

Is there a more efficient way of coding the above.

Our company has now upgraded to Excel 2007 which is the reason for the

change.

Thanks in advance,

edul

uSub FilterByDateTime()
Dim sd As Double

If IsDate(Range("r1")) Then
sd = Range("s1") '+14 = 2pm
sdDate = DateSerial(Year(sd), Month(sd), Day(sd)) + _
TimeSerial(Hour(sd), Minute(sd), Second(sd))

With ActiveSheet.UsedRange
.AutoFilter Field:=16, Criteria1:="<=" & sd _
, Operator:=xlOr, Criteria2:="" & sd + 1 '+ 1 day
.Offset(1).EntireRow.Delete
.AutoFilter
End With
End If
End Subse this

Wow! Thanks Don.
Never even thought to use AutoFilter that way.
Can't believe how quick that runs.
Thanks very much.