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
|