Add number to s"cycle" calculation

[abesimpson]

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 is a date field and it is here that I have my problem. I would like to perform the calculation on today’s date, export the results, then today -1, export the data, today -2… etc.

Any suggestions?


I can provide the macro I am using if it is of any interest.

Thanks

a

 

[Legacy 51064]

Yes, please post the macro.

 

[abesimpson]

Macro

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\Malcolm McRae\My Documents\indigo trades\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)).ClearContents

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

End Sub