Start time help

[kmcosta]

I would like to start running my macro at 930am every morning. I am aware of the application.ontime function, but do not know where to place it in my code. My macro is named FRData, but I am not sure if I need to create a new module for the "application.on time" function. I am very new to VB programming, so please be gentle with me and assume nothing. Thanks in advance for the help!!

[GTO]

I'm at work and believe the feature may be disabled, so no ability to check... but have you tried Scheduled Tasks?

[kmcosta]

I am using Excel 2003 for Windows. I am not aware of a Scheduled Tasks feature with this.

[GTO]

Look under Start Button | Settings | Control Panel.

Click/Double-Click the Scheduled Tasks Icon. I could be wrong, but if is a macro to just be run once at a certain time, I was thinking a vbs script might be a thought.

[Bob Phillips]

Have alook at Ontime http://www.cpearson.com/excel/OnTime.aspx

[kmcosta]

Can I just include the application.ontime command at the beginning of the sub I wrote??:

[VBA]Sub FRData()

'
' FRData Macro
' Macro recorded 12/19/2006 by Kevin M. Costa
'



Const DATEFORMAT As String = "d-mmm-yy"
Dim Filename1 As String
Dim Filename2 As String
Dim Filename3 As String
Dim Filename4 As String
Dim Filename5 As String
Dim Filename6 As String
Dim Filename7 As String
Dim Filename8 As String
Dim Filename9 As String
Dim Filename10 As String
Dim Filename11 As String
Dim Filename12 As String

Const DirSearch As String = "C:\Documents and Settings\Kevin M. Costa\Desktop\data\"
Filename1 = Dir(DirSearch & "*.000")
Filename2 = Dir(DirSearch & "*.002")
Filename3 = Dir(DirSearch & "*.009")
Filename4 = Dir(DirSearch & "*.061")
Filename5 = Dir(DirSearch & "*.006")
Filename6 = Dir(DirSearch & "*.434")
Filename7 = Dir(DirSearch & "*.008")
Filename8 = Dir(DirSearch & "*.086")
Filename9 = Dir(DirSearch & "*.007")
Filename10 = Dir(DirSearch & "*.066")
Filename11 = Dir(DirSearch & "*.599")
Filename12 = Dir(DirSearch & "*.AL6")
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename1, Destination:=Range("A43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename2, Destination:=Range("B43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-12
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename3, Destination:=Range("C43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-15
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename4, Destination:=Range("D43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-15
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename5, Destination:=Range("E43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename6, Destination:=Range("F43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename7, Destination:=Range("G43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename8, Destination:=Range("H43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename9, Destination:=Range("I43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename10, Destination:=Range("J43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename11, Destination:=Range("K43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & DirSearch & Filename12, Destination:=Range("L43"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-24
Columns("B:B").ColumnWidth = 3.75
Columns("C:C").ColumnWidth = 3.75
Columns("D").ColumnWidth = 3.75
Columns("E:E").ColumnWidth = 3.75
Columns("F:F").ColumnWidth = 3.75
Columns("G:G").ColumnWidth = 3.75
Columns("H:H").ColumnWidth = 3.75
Columns("I:I").ColumnWidth = 3.75
Columns("J:J").ColumnWidth = 3.75
Columns("K:K").ColumnWidth = 3.75
Columns("L:L").ColumnWidth = 3.75
Columns("M:M").ColumnWidth = 3.75
Columns("N:N").ColumnWidth = 3.75

Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngFind1 As Range, rngcopy As Range
Dim rngFind2 As Range
Dim rngFind3 As Range
Dim rngFind4 As Range
Dim rngFind5 As Range
Dim rngFind6 As Range
Dim rngFind7 As Range
Dim rngFind8 As Range
Dim rngFind9 As Range
Dim rngFind10 As Range
Dim rngFind11 As Range
Dim rngFind12 As Range
Dim rngFind13 As Range
Dim rngFind14 As Range
Dim dtFind As Date
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("000")
Set ws3 = ThisWorkbook.Sheets("002")
Set ws4 = ThisWorkbook.Sheets("009")
Set ws5 = ThisWorkbook.Sheets("061")
Set ws6 = ThisWorkbook.Sheets("006")
Set ws7 = ThisWorkbook.Sheets("434")
Set ws8 = ThisWorkbook.Sheets("008")
Set ws9 = ThisWorkbook.Sheets("086")
Set ws10 = ThisWorkbook.Sheets("007")
Set ws11 = ThisWorkbook.Sheets("066")
Set ws12 = ThisWorkbook.Sheets("599")
Set ws13 = ThisWorkbook.Sheets("AL6")
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind1 = ws2.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws2.Cells(1, 1), LookIn:=xlValues)
If rngFind1 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B5:Z5").Copy
Application.ScreenUpdating = False
ws2.Activate
rngFind1.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind2 = ws3.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws3.Cells(1, 1), LookIn:=xlValues)
If rngFind2 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B6:Z6").Copy
Application.ScreenUpdating = False
ws3.Activate
rngFind2.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind3 = ws4.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws4.Cells(1, 1), LookIn:=xlValues)
If rngFind3 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B7:Z7").Copy
Application.ScreenUpdating = False
ws4.Activate
rngFind3.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind4 = ws5.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws5.Cells(1, 1), LookIn:=xlValues)
If rngFind4 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B8:Z8").Copy
Application.ScreenUpdating = False
ws5.Activate
rngFind4.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind5 = ws6.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws6.Cells(1, 1), LookIn:=xlValues)
If rngFind5 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B9:Z9").Copy
Application.ScreenUpdating = False
ws6.Activate
rngFind5.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind6 = ws7.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws7.Cells(1, 1), LookIn:=xlValues)
If rngFind6 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B10:Z10").Copy
Application.ScreenUpdating = False
ws7.Activate
rngFind6.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind7 = ws8.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws8.Cells(1, 1), LookIn:=xlValues)
If rngFind7 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B11:Z11").Copy
Application.ScreenUpdating = False
ws8.Activate
rngFind7.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind8 = ws9.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws9.Cells(1, 1), LookIn:=xlValues)
If rngFind8 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B12:Z12").Copy
Application.ScreenUpdating = False
ws9.Activate
rngFind8.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind9 = ws10.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws10.Cells(1, 1), LookIn:=xlValues)
If rngFind9 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B13:Z13").Copy
Application.ScreenUpdating = False
ws10.Activate
rngFind9.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind10 = ws11.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws11.Cells(1, 1), LookIn:=xlValues)
If rngFind10 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B14:Z14").Copy
Application.ScreenUpdating = False
ws11.Activate
rngFind10.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind11 = ws12.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws12.Cells(1, 1), LookIn:=xlValues)
If rngFind11 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B19:T19").Copy
Application.ScreenUpdating = False
ws12.Activate
rngFind11.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
dtFind = CDate(ws1.Cells(1, 2).Value)
Set rngFind12 = ws13.Columns(1).Find(what:=Format(dtFind, DATEFORMAT), after:=ws13.Cells(1, 1), LookIn:=xlValues)
If rngFind12 Is Nothing Then
MsgBox "Date was not found!", vbInformation
Exit Sub
End If
Worksheets("Sheet1").Range("B20:T20").Copy
Application.ScreenUpdating = False
ws13.Activate
rngFind12.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
MsgBox "Copy complete!", vbInformation

ActiveWorkbook.Save
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Kevin M. Costa\Desktop\DAILYDATA\SADataOpII" & Format(Date - 1, "yyyymmdd") & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks.Open Filename:="C:\Documents and Settings\Kevin M. Costa\Desktop\SADataOpII.xls"
Sheets("Sheet1").Select
Range("A43:N20000").Select
Selection.clearcontents
Selection.QueryTable.Delete
Range("c23").Select
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub[/VBA]

[Bob Phillips]

No, read the article, it shows you how to do it.