Run macro multiple times
 

I am currently using a macro that imports a text file, does some data
manipulation and then export the results to another text file.

One of the fields in the spreadsheet is a date field with a reference
value -1, -2, etc., it is here that I have my problem. I would like to
perform the calculation on today’s date (NOW()), export the results,
then NOW() -1, export the data, NOW() -2..., etc.

The macro I am using is as follows:

Sub Manual()

' Ticker Import Function
Range("A2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\fundamental.txt", Destination:= _
Range("A2"))
..Name = "test"
..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

' QP Data Copy
Range("B2", Range("B2").End(xlToRight)).Copy
Selection.End(xlDown).Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Macro Delay (may be required while QP Data propagates)
' Application.Wait Now + TimeValue("00:00:??")

' New Worksheet Name, save as: (Now, "mmmm dd yyyy hh-mm" & " QP
FunData.xls")
Dim W As Workbook
Set W = Workbooks.Add(xlWBATWorksheet)
Range("A1").Select
W.Sheets("Sheet1").Range("A1:EH15000") = _
ThisWorkbook.Sheets("Sheet1").Range("A1:EH15000"). Value
ChDir "C:\Documents and Settings\fundamental data\"
W.SaveAs Application.WorksheetFunction.Text(Now, "mmmm dd yyyy hh-mm")
& " QP FunData.xls"

' Save and close open Workbook(1)
Dim Wb As Workbook
For Each Wb In Workbooks
If Wb.Name < ThisWorkbook.Name Then
Wb.Close savechanges:=True
End If
Next Wb

Application.Wait Now + TimeValue("00:00:20")
' Delete Ticker List
Range("A2", Range("A2").End(xlDown)).ClearContents

' Delete Data Rows
Range("B3", Range("B3").End(xlToRight).End(xlDown)).ClearConte nts

Application.Wait Now + TimeValue("00:00:05")
' Save and close open Workbook(2)
Range("A1").Select
ThisWorkbook.Save
Application.Quit

End Sub

Any suggestions (I hope I am being clear)?


Thanks


--
kriemer
------------------------------------------------------------------------
kriemer's Profile: http://www.excelforum.com/member.php...o&userid=28724
View this thread: http://www.excelforum.com/showthread...hreadid=484181