Brett,
That's one reason why I made the Interpolation a function, so you can change
the calculation to match your requirements easily.
Just adjust that calculation and/or the before/after values passed to it to
achieve desired method.

NickHK

"Brett" wrote in message
oups.com...
Nick
I ran the code and it works, however the algorithm for calculating the
cumulative rainfall amount at the fixed time interval does not work.
The values that are calculated don't fit the measured data results. The
interpolation should calculate the fixed interval cumulative rainfall
amount between the measured times before and after the fixed time
interval. For example
if the
TM PM Ti Pi
10:00 1 10:00 1
10:08 2 10:15 2.6
10:20 3 etc.
if the cumulative measured precip. does not change between measured
times the fixed interval cumulative should not change as well.
Thanks again for all your help.
Brett



NickHK wrote:
Brett,
OK, try this. I've made more interactive, so hopefully you should just
need
to paste the code and run it.
Again, not tested much, so see what it does with some of your data.
If you make a chart of the before and after data, you can see if the
results
are desirable.

NickHK

< Code
Option Explicit

Private Type Point
X As Single
Y As Single
End Type

Private WorkingData As Range

Private Sub CommandButton1_Click()
Dim RetVal As Variant
Dim OutputArray As Variant

Dim StartRange As Range
Dim EndRange As Range
Dim IntervalMinutes As Long

Set StartRange = Application.InputBox("Select the start of the data.", ,
, ,
, , , 8)
Set EndRange = Application.InputBox("Select the end of the data.", , , ,
, ,
, 8)
IntervalMinutes = Application.InputBox("Enter the adjusted time interval
in
minutes.", , 15, , , , , 1)

RetVal = NormaliseArray(Range(StartRange.Address, EndRange.Address),
IntervalMinutes, OutputArray)

If IsNumeric(RetVal) = True Then
MsgBox "Normalised to " & RetVal & " elements"
Set StartRange = Application.InputBox("Select the start of the
output
data.", , , , , , , 8)
StartRange.Resize(RetVal, 2) = OutputArray
Else
MsgBox "Error : " & RetVal
End If

End Sub

Private Function NormaliseArray(ByVal InputData As Range, _
IntervalMinutes As Long, _
ByRef OutData As Variant, _
Optional BaseQty As Single = 1) _
As Variant

Dim TimeTaken As Double
Dim QuantityCollected As Single
Dim NewElementCount As Long
Dim Counter As Long

Dim SPoint As Point
Dim EPoint As Point
Dim LastProcessedDataRow As Long

Const OneMinute As Single = 1 / 24 / 60
Const ERR_ARRAYCANNOTRESIZE As Long = 10

'Make sure there is more than 1 row of data
If InputData.Rows.Count < 2 Then
NormaliseArray = "Not enough data"
Exit Function
End If

'Create a local copy
Set WorkingData = InputData

'The time taken for the original data
TimeTaken = CDate(WorkingData(WorkingData.Rows.Count).Value) -
CDate(WorkingData(1).Value)

'The number of elements required to cover the data, with the new time
interval
NewElementCount = RoundUp(TimeTaken / (IntervalMinutes * OneMinute))

On Error Resume Next

'Resize the the OutputData variable, including the Start element
ReDim OutData(0 To NewElementCount, 1 To 2)
If Err.Number = ERR_ARRAYCANNOTRESIZE Then
NormaliseArray = "Cannot resize output array"
Exit Function
End If
On Error GoTo 0

LastProcessedDataRow = 1

'Set the value of element(0) to the same as the element(0) of
WorkingData
OutData(0, 1) = WorkingData(LastProcessedDataRow, 1)
OutData(0, 2) = WorkingData(LastProcessedDataRow, 2)

For Counter = 1 To NewElementCount
'See if we have reached the end of the sample data
If LastProcessedDataRow < WorkingData.Rows.Count Then
'Still elements, so update
SPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value
SPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value

LastProcessedDataRow = GetNextDataRow(LastProcessedDataRow,
IntervalMinutes * OneMinute)

EPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value
EPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value
Else
'Last element used, so keep previous 2 points
'And project new value
End If
'Set the new time
OutData(Counter, 1) = DateAdd("n", IntervalMinutes,
OutData(Counter - 1,
1))
'Calculate the new Y value from the X value and 2 points using
Y=mX+C
OutData(Counter, 2) = InterpolateY(SPoint, EPoint,
CSng(OutData(Counter,
1)))
Debug.Print OutData(Counter, 1), OutData(Counter, 2)
Next

NormaliseArray = NewElementCount + 1

End Function

Private Function RoundUp(sngInBound) As Long
RoundUp = CLng(sngInBound + 0.5)
End Function

'Function based on Y=mX+C and 2 know points
Private Function InterpolateY(StartPoint As Point, EndPoint As Point,
KnownValueX As Single) As Single
Dim Gradient As Single
Dim Intercept As Single

Gradient = (EndPoint.Y - StartPoint.Y) / (EndPoint.X - StartPoint.X)
Intercept = EndPoint.Y - Gradient * EndPoint.X

InterpolateY = Gradient * KnownValueX + Intercept

End Function

'Find the next sample data element that is = the previous element+the
interval
'Or we reach the end of the sample data
Private Function GetNextDataRow(StartingFrom As Long, MinimumInterval As
Single) As Long
Dim Counter As Long

Counter = 0
With WorkingData.Cells(StartingFrom, 1)
Debug.Print .Offset(Counter, 0).Value
Do Until .Offset(Counter, 0).Value = .Value + MinimumInterval Or
StartingFrom + Counter = WorkingData.Rows.Count
Counter = Counter + 1
Loop
End With

GetNextDataRow = StartingFrom + Counter

End Function
</ Code

"Brett" wrote in message
oups.com...
Nick
I did try the code posted, and it didn't give any output, should I
load
the existing array of measured data and then try to run the function
on
it, not sure how to do this? The reason I would like to interpolate
points at the 15 minute intervals is due to the fact that at say 8
minutes the cumulative rainfall is perhaps 3 and at 28 minutes the
cumulative rainfall is 3.5 and I am trying to get an estimate between
these two points for the 15 minute interval. So the linear
relationship
is not among the whole dataset, only between two points of measured
time. Does that make any sense? Thanks again for your interest.

Brett
-------------- CUT ----------------------------