The following script does some fairly simple stuff.
- Find all unique records with the latest date (from Details)
- Puts those records on Worksheet2 (aka Summary)
- Converts dates from text to date form
It is soooo slow. I have Applescript launch it and usually it times out.
I wonder if an Applescript is possible…
Dave
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