ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Script works very slow! (https://www.excelbanter.com/excel-programming/391546-script-works-very-slow.html)

dzelnio
Script works very slow!
 
The following script does some fairly simple stuff.
1. Find all unique records with the latest date (from Details)
2. Puts those records on Worksheet2 (aka Summary)
3. Converts dates from text to date form

Can anyone see anything in here that would make it soooo slow?



Option Explicit
Sub Summary()
Dim lastrow As Long, path As String, today As Long, Ans As Variant

Application.ScreenUpdating = False
Sheets("Summary").Select
Rows("2:3000").ClearContents

Sheets("Details").Select
lastrow = Cells(3000, 1).End(xlUp).Row
Range(Cells(2, 5), Cells(lastrow, 5)).Select
Selection.FormulaR1C1 = "=DATEVALUE(MID(RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1)+1,FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1))-FIND("" "",RC[-3],FIND("" "",RC[-3])
+1+1)-1) & ""-"" & LEFT(MID(RC[-3],FIND("" "",RC[-3])+1,FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1)-FIND("" "",RC[-3])+1),3) & "" -"" &
MID(RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1))
+2,FIND("" "",RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))+2)-FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))-2))+TIMEVALUE(MID(RC[-3],FIND(""
"",RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1))
+2)+1,15))"
Selection.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
Selection.Copy
Cells(2, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Selection.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").ClearContents

Sheets("Summary").Select
Range(Sheets("Details").Cells(3, 1), Sheets("Details").Cells(lastrow,
4)).Copy Cells(2, 1)


lastrow = Cells(3000, 1).End(xlUp).Row
Columns("A:E").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("B2") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom
Range(Cells(2, 5), Cells(lastrow, 5)).FormulaR1C1 =
"=IF(RC1<R[-1]C1,""Y"",""N"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Sort Key1:=Range("E2"), Order1:=xlDescending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

Ans = Application.CountIf(Columns("E"), "Y")
Rows(Ans + 2 & ":" & 3000).ClearContents
Columns("E").ClearContents
ActiveWindow.ScrollRow = 2
Cells(2, 1).Select
End Sub

Trevor Shuttleworth
Script works very slow!
 
Can't test this properly because I don't know what the data looks like.

Try to avoid selecting cells wherever possible. For example:

Option Explicit
Sub Summary()
Dim lastrow As Long, path As String, today As Long, Ans As Variant

Application.ScreenUpdating = False
Sheets("Summary").Select
Rows("2:3000").ClearContents

Sheets("Details").Select
lastrow = Cells(3000, 1).End(xlUp).Row
With Range(Cells(2, 5), Cells(lastrow, 5))
.FormulaR1C1 = "=DATEVALUE(MID(RC[-3],FIND("""",RC[-3],FIND(""
"",RC[-3])+1+1)+1,FIND("","",RC[-3],FIND("""",RC[-3],FIND(""
"",RC[-3])+1+1))-FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1)-1) & ""-"" &
LEFT(MID(RC[-3],FIND("" "",RC[-3])+1,FIND("""",RC[-3],FIND(""
"",RC[-3])+1+1)-FIND("" "",RC[-3])+1),3) & "" -"" &
MID(RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))+2,FIND("" "",RC[-3],FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("""",RC[-3])+1+1))+2)-FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("""",RC[-3])+1+1))-2))+TIMEVALUE(MID(RC[-3],FIND("""",RC[-3],FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1))+2)+1,15))"
.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
.Copy
End With
With Cells(2, 2)
.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With
With Columns("B:B")
.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").ClearContents

Sheets("Summary").Select
Range(Sheets("Details").Cells(3, 1), Sheets("Details").Cells(lastrow,
4)).Copy Cells(2, 1)

lastrow = Cells(3000, 1).End(xlUp).Row
Columns("A:E").Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
With Range(Cells(2, 5), Cells(lastrow, 5))
.FormulaR1C1 = "=IF(RC1<R[-1]C1,""Y"",""N"")"
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.Sort Key1:=Range("E2"), Order1:=xlDescending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

Ans = Application.CountIf(Columns("E"), "Y")
Rows(Ans + 2 & ":" & 3000).ClearContents
Columns("E").ClearContents
ActiveWindow.ScrollRow = 2
Cells(2, 1).Select
End Sub

Regards

Trevor


"dzelnio" wrote in message
ups.com...
The following script does some fairly simple stuff.
1. Find all unique records with the latest date (from Details)
2. Puts those records on Worksheet2 (aka Summary)
3. Converts dates from text to date form

Can anyone see anything in here that would make it soooo slow?



Option Explicit
Sub Summary()
Dim lastrow As Long, path As String, today As Long, Ans As Variant

Application.ScreenUpdating = False
Sheets("Summary").Select
Rows("2:3000").ClearContents

Sheets("Details").Select
lastrow = Cells(3000, 1).End(xlUp).Row
Range(Cells(2, 5), Cells(lastrow, 5)).Select
Selection.FormulaR1C1 = "=DATEVALUE(MID(RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1)+1,FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1))-FIND("" "",RC[-3],FIND("" "",RC[-3])
+1+1)-1) & ""-"" & LEFT(MID(RC[-3],FIND("" "",RC[-3])+1,FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1)-FIND("" "",RC[-3])+1),3) & "" -"" &
MID(RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1))
+2,FIND("" "",RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))+2)-FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))-2))+TIMEVALUE(MID(RC[-3],FIND(""
"",RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1))
+2)+1,15))"
Selection.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
Selection.Copy
Cells(2, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Selection.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").ClearContents

Sheets("Summary").Select
Range(Sheets("Details").Cells(3, 1), Sheets("Details").Cells(lastrow,
4)).Copy Cells(2, 1)


lastrow = Cells(3000, 1).End(xlUp).Row
Columns("A:E").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("B2") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom
Range(Cells(2, 5), Cells(lastrow, 5)).FormulaR1C1 =
"=IF(RC1<R[-1]C1,""Y"",""N"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Sort Key1:=Range("E2"), Order1:=xlDescending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

Ans = Application.CountIf(Columns("E"), "Y")
Rows(Ans + 2 & ":" & 3000).ClearContents
Columns("E").ClearContents
ActiveWindow.ScrollRow = 2
Cells(2, 1).Select
End Sub

dzelnio
Script works very slow!
 
I get it. Thanks Trevor.

dzelnio

On Jun 18, 5:48 pm, "Trevor Shuttleworth"
wrote:
Can't test this properly because I don't know what the data looks like.

Try to avoid selecting cells wherever possible. For example:

Option Explicit
Sub Summary()
Dim lastrow As Long, path As String, today As Long, Ans As Variant

Application.ScreenUpdating = False
Sheets("Summary").Select
Rows("2:3000").ClearContents

Sheets("Details").Select
lastrow = Cells(3000, 1).End(xlUp).Row
With Range(Cells(2, 5), Cells(lastrow, 5))
.FormulaR1C1 = "=DATEVALUE(MID(RC[-3],FIND("""",RC[-3],FIND(""
"",RC[-3])+1+1)+1,FIND("","",RC[-3],FIND("""",RC[-3],FIND(""
"",RC[-3])+1+1))-FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1)-1) & ""-"" &
LEFT(MID(RC[-3],FIND("" "",RC[-3])+1,FIND("""",RC[-3],FIND(""
"",RC[-3])+1+1)-FIND("" "",RC[-3])+1),3) & "" -"" &
MID(RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))+2,FIND("" "",RC[-3],FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("""",RC[-3])+1+1))+2)-FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("""",RC[-3])+1+1))-2))+TIMEVALUE(MID(RC[-3],FIND("""",RC[-3] ,FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1))+2)+1,15))"
.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
.Copy
End With
With Cells(2, 2)
.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With
With Columns("B:B")
.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").ClearContents

Sheets("Summary").Select
Range(Sheets("Details").Cells(3, 1), Sheets("Details").Cells(lastrow,
4)).Copy Cells(2, 1)

lastrow = Cells(3000, 1).End(xlUp).Row
Columns("A:E").Sort _
Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlDescending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
With Range(Cells(2, 5), Cells(lastrow, 5))
.FormulaR1C1 = "=IF(RC1<R[-1]C1,""Y"",""N"")"
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.Sort Key1:=Range("E2"), Order1:=xlDescending, _
Key2:=Range("A2"), Order2:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
End With

Ans = Application.CountIf(Columns("E"), "Y")
Rows(Ans + 2 & ":" & 3000).ClearContents
Columns("E").ClearContents
ActiveWindow.ScrollRow = 2
Cells(2, 1).Select
End Sub

Regards

Trevor

"dzelnio" wrote in message

ups.com...

The following script does some fairly simple stuff.
1. Find all unique records with the latest date (from Details)
2. Puts those records on Worksheet2 (aka Summary)
3. Converts dates from text to date form

Can anyone see anything in here that would make it soooo slow?

Option Explicit
Sub Summary()
Dim lastrow As Long, path As String, today As Long, Ans As Variant

Application.ScreenUpdating = False
Sheets("Summary").Select
Rows("2:3000").ClearContents

Sheets("Details").Select
lastrow = Cells(3000, 1).End(xlUp).Row
Range(Cells(2, 5), Cells(lastrow, 5)).Select
Selection.FormulaR1C1 = "=DATEVALUE(MID(RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1)+1,FIND("","",RC[-3],FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1))-FIND("" "",RC[-3],FIND("" "",RC[-3])
+1+1)-1) & ""-"" & LEFT(MID(RC[-3],FIND("" "",RC[-3])+1,FIND(""
"",RC[-3],FIND("" "",RC[-3])+1+1)-FIND("" "",RC[-3])+1),3) & "" -"" &
MID(RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1))
+2,FIND("" "",RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))+2)-FIND("","",RC[-3],FIND("" "",RC[-3],FIND(""
"",RC[-3])+1+1))-2))+TIMEVALUE(MID(RC[-3],FIND(""
"",RC[-3],FIND("","",RC[-3],FIND("" "",RC[-3],FIND("" "",RC[-3])+1+1))
+2)+1,15))"
Selection.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
Selection.Copy
Cells(2, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Selection.NumberFormat = "mm/dd/yy hh:mm:ss AM/PM"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("E:E").ClearContents

Sheets("Summary").Select
Range(Sheets("Details").Cells(3, 1), Sheets("Details").Cells(lastrow,
4)).Copy Cells(2, 1)

lastrow = Cells(3000, 1).End(xlUp).Row
Columns("A:E").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Key2:=Range("B2") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom
Range(Cells(2, 5), Cells(lastrow, 5)).FormulaR1C1 =
"=IF(RC1<R[-1]C1,""Y"",""N"")"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.Sort Key1:=Range("E2"), Order1:=xlDescending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

Ans = Application.CountIf(Columns("E"), "Y")
Rows(Ans + 2 & ":" & 3000).ClearContents
Columns("E").ClearContents
ActiveWindow.ScrollRow = 2
Cells(2, 1).Select
End Sub


All times are GMT +1. The time now is 03:39 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com