View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
dzelnio dzelnio is offline
external usenet poster
 
Posts: 14
Default 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