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