Hi everybody
I have've been asked to do something but I can get only to a point and I am now stuck. Please help.
I have written a Sub in VBA for Excel 2003 (see below) in which the top cell of a range (WorkRange) is initially set at Cells(1,2), where there is the first available price for a price series. Prices stream into the spreadsheet (streaming is provided independently from the Sub I wrote).
For each new price that streams in the Sub calculates the max price (called: MaxVal) and a min value (MinVal) for the price series over the range:
WorkRange="Cells(1,2),Cells(ActiveSheet.Columns(2).SpecialCells(xlLastCell).Row,2)"
that is the range from (1,2) to the bottom non-empty cell in column 2. The Sub also pastes the values to dedicated columns. The WorkRange keeps extending down in Excel as prices stream in the spreadsheet.
The Sub also calculates the updated differences betwen the last price and the MaxVal and MinVal calculated on the updated WorkRange (such differences I called diffM and diffI respectively).
My question is: how do I reset the top cell of the WorkRange when the variables diffM and diffI go beyond certain values ?
In other words if diffI=(LastPrice-MinVal)>(z*LastPrice) I want to reset the top cell of the WorkRange (or set a new WorkRange=WorkRange1) so that the top cell of the WorkRange is no longer Cells(1,2) but the cell where the MinVal is. I also want to keep unchanged all the output I got up to that point.
In other words. Say that the > condition occurred in cell (k,2) and that the MinVal (calculated over Range((1,2):(k,2)) is in cell (j,2), where j<k. Then I want the program, from cell (k+1,2) down, to reset the WorkRange to:
WorkRange="Cells(j,2),Cells(ActiveSheet.Columns(2).SpecialCells(xlLastCell).Row,2)", so that the max and miv values, along with the differences, will be calculated on this new range rather than from the beginning.
As I said all outputs already pasted up to cell (j) should be left unchanged. I realise that there might be more than one cell for which price = MaxVal or MinVal, in which case the most recent cell should be set = j.
The resetting of the WorkRange should be repeated whenever the specified conditions occur.
I estimate that the data series could be up to 40,000 rows long.
Here is the sub() I wrote
-----------------------------------
Sub Calc1()
Dim LastRow As Integer
Dim WorkRange As Range
Dim diffM As Double
Dim diffI As Double
Dim MaxVal As Double
Dim MinVal As Double
Dim LastPrice As Double
Dim za As Double
Const z = 0.003
' define LastRow
LastRow = ActiveSheet.Columns(2).SpecialCells(xlLastCell).Row
LastPrice = Cells(LastRow, 2).Value
' set WorkRange
Set WorkRange = ActiveSheet.Range(Cells(1, 2), Cells(LastRow, 2))
' calculate MaxVal and put value in dedicated column
MaxVal = Application.Max(WorkRange)
Cells(LastRow, 3).Value = MaxVal
' calculate MinVal and put value in dedicated column
MinVal = Application.Min(WorkRange)
Cells(LastRow, 4).Value = MinVal
' define difference: (price - maximum-2-date)
diffM = LastPrice - Cells(LastRow, 3).Value
Cells(LastRow, 5).Value = diffM
' define difference: (price - minimum-2-date)
diffI = LastPrice - Cells(LastRow, 4).Value
Cells(LastRow, 6).Value = diffI
' if (price - min) > z then put value 1 in dedicated column, otherwise 0
If diffI > z * LastPrice Then Cells(LastRow, 8).Value = 1 Else Cells(LastRow, 8) = 0
' if (price - max) < -z then put value 1 in dedicated column, otherwise 0
If diffM < -z * LastPrice Then Cells(LastRow, 7).Value = 1 Else Cells(LastRow, 7) = 0
' send z*LastPrice in dedicated column
za = z * LastPrice
Cells(LastRow, 10).Value = za
End Sub
---------------------------------------------
I guess that the Sub can be made to Loop in one way or the other but I do not know how to do that and have not much time to search for solutions. Anybody can help ?
Thank you in advance
Frank