Code: Select all
Sub CopyCellsFormulas()
Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
Dim dteDateValue As Date
Dim dbl9Value As Double, dbl21Value As Double
Dim DataCol As Range
Const defName As String = "DataCol"
Const defNameOEX_High As String = "OEX_High"
Const defNameOEX_Low As String = "OEX_Low"
Const defNameDATE_Range As String = "DATE_Range"
Application.EnableEvents = False
'New Data Aquisitions Begins 10/21/2003
'01/02/2004 Row 53
'07/01/2004 Row 177
'01/03/2005 Row 305
'07/01/2005 Row 430
'01/03/2006 Row 557
'07/03/2006 Row 682
'01/02/2009 Row 1312
'01/03/2012 Row 2067
'07/02/2012 Row 2142
'01/02/2013 Row 2267
'07/01/2013 Row 2391
'01/02/2014 Row 2519
'07/01/2016 Row 3148
intStartRow = 3148
I = intStartRow
Worksheets("Vix").Activate
Do
I = I + 1
Range(Cells(I - 2, 6), Cells(I - 2, 9)).Copy
Range(Cells(I - 1, 6), Cells(I - 1, 9)).PasteSpecial xlPasteAll
Loop Until Cells(I, 2) = ""
Cells(I, 2).Select
dteDateValue = Cells(I - 2, 1)
I = intStartRow
Worksheets("PutCall Ratio").Activate
Do
I = I + 1
Range(Cells(I - 2, 6), Cells(I - 2, 8)).Copy
Range(Cells(I - 1, 6), Cells(I - 1, 8)).PasteSpecial xlPasteAll
Loop Until Cells(I, 2) = ""
I = intStartRow
Do
dbl9Value = 0: dbl21Value = 0
For J = I To (I - 20) Step -1
dbl21Value = Cells(J, 5) + dbl21Value
Next J
For J = I To (I - 8) Step -1
dbl9Value = Cells(J, 5) + dbl9Value
Next J
If I > 9 Then Cells(I, 11) = dbl9Value / 9
If I > 20 Then Cells(I, 12) = dbl21Value / 21
Cells(I, 11).NumberFormat = "0.00": Cells(I, 12).NumberFormat = "0.00"
I = I + 1
Loop Until Cells(I, 1) > Now() Or Cells(I, 2) = ""
Cells(I, 2).Select
I = intStartRow
Worksheets("OEX").Activate
Do
I = I + 1
Range(Cells(I - 2, 8), Cells(I - 2, 8)).Copy
Range(Cells(I - 1, 8), Cells(I - 1, 8)).PasteSpecial xlPasteAll
Loop Until Cells(I, 3) = ""
Cells(I, 3).Select
R = Cells(Rows.Count, "D").End(xlUp).Row
ActiveWorkbook.Names.Add Name:=defNameOEX_High, RefersTo:="=" & ActiveSheet.Name & "!" & Range("D2", Cells(R + 1, "D")).Address
R = Cells(Rows.Count, "E").End(xlUp).Row
ActiveWorkbook.Names.Add Name:=defNameOEX_Low, RefersTo:="=" & ActiveSheet.Name & "!" & Range("E2", Cells(R + 1, "E")).Address
R = Cells(Rows.Count, "A").End(xlUp).Row
ActiveWorkbook.Names.Add Name:=defNameDATE_Range, RefersTo:="=" & ActiveSheet.Name & "!" & Range("A2", Cells(R + 1, "A")).Address
I = intStartRow - 80
Worksheets("Calc").Activate
Do
I = I + 1
Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy
Range(Cells(I, 1), Cells(I, 7)).PasteSpecial xlPasteAll
Loop Until Cells(I, 2) = ""
Range(Cells(I - 1, 1), Cells(I - 1, 7)).Copy
Range(Cells(I, 1), Cells(I, 7)).PasteSpecial xlPasteAll
Cells(I, 1).Select
R = Cells(Rows.Count, "B").End(xlUp).Row
ActiveWorkbook.Names.Add Name:=defName, RefersTo:="=" & ActiveSheet.Name & "!" & Range("B2", Cells(R, "B")).Address
Application.EnableEvents = True
End Sub
Anyway several questions remain open from the experience.
1. Is there a setting that forces linked data be opened in the current session of Excel, instead of opening up another session?
2. Notice in the code Application.EnableEvents = False, yet I sit and WATCH every calculation
3. What if any exists a key stroke for breaking/stopping a macro? The calculation took over an hour, Yuk.
EDIT add a piece of the workbook