Interpolation & Extrapolation

I need a function that when passed the difference between the x and y values will interpolate or extrapolate depending on whether the data is at the extremities or within the set.

e.g

I have this

50     60    70    80
time   1   1           3     4
2          2    4     6
3   3      5          9
4   4           8

I need the function to fill in the missing data

Any ideas ???

Thanx

ie
Who is Participating?

Commented:
ie1978, was my previous code helpful?  The current restriction of two-consecutive entries could be overcome with some additional coding and maybe using a search algorithm to count to the next non-missing entry, then divide by the number of blanks:

5 _ _ _ 9

Then seeking the second value, count ahead 3 and compare against the previous to get (9-5)/(3+1), which is your increment, then add to the previous to get 6.
0

Senior DBACommented:
50     60    70    80
time  1   1           3     4
2          2    4     6
3   3      5          9
4   4           8

Extrapolation is chancy, and interpolation can be imprecise.  Based on what your sample grid (above) shows, you could end up with:

(Interpolate / Extrapolate across)

50     60    70    80
time  1   1     <2>   3     4
2  <0>     2    4     6
3   3      5   <7>    9
4   4     <6>   8    <10>

OR:

(Interpolate / Extrapolate down 1)

50     60    70    80
time  1   1     <1>   3     4
2  <2>     2    4     6
3   3      5   <5>    9
4   4     <8>   8    <12>

OR:

(Interpolate / Extrapolate down 2)

50     60    70    80
time  1   1     <1>   3     4
2  <2>     2    4     6
3   3      5   <6>    9
4   4     <13>  8    <13>

The basics of interpolation / extrapolation would be to try and predict the value that would be in the missing location.  To do this well, a curve-matching algorithm is usually best suited, although averaging methods will work for many cases.  However, determining what algorithm provides you with the data you 'expect' is the hard part of this.  Without knowing the 'expected' pattern, and the direction of interpolation, the matching is very difficult.  Even with that information, matching would be difficult.
0

Commented:
If you're simply trying to fill in the blanks based on previous and next, your could try a simply average, such as the code below.

' First, set up your array of entries:
entrycount=4
itemcount=entrycount - 1
dim mylist(itemcount)
for i=0 to itemcount
next i

' Then search for blank entries
for i=0 to itemcount
if mylist(i) = "" then
' try to figure out the value
if i= 0 then
' at beginning of list, so check next two
mylist(i) = mylist(i+2) - mylist(i+1)
elseif i=itemcount then
' at end of list, so check previous two
mylist(i) = mylist(i-1) - mylist(i-2)
else
' in middle of list, so check previous and next
mylist(i) = (mylist(i-1) + mylist(i+1)) / 2
endif
endif
next i

' Finally, print the new list
for i=0 to itemcount
print mylist(i)
next i

There are some assumptions here:
1) There will never be two consecutive blank entries
2) Each missing entry is part of an arithmetic progression

I think the above will work for the cases you indicated.
0

Commented:
Hi
'**** two base functions***

Option Explicit
Option Base 1
Dim M() As Single, X() As Single, Y() As Single

'***Calculating Cubic Spline constants for array***

Private Function PrepareSpline(inpArr() As Single) As Boolean
Dim n As Integer, i As Integer
Dim L() As Single, R() As Single, S() As Single
Dim D As Single, E As Single, F As Single, H As Single, P As Single
PrepareSpline = False
On Error Resume Next
n = UBound(inpArr, 2)
On Error GoTo 0
If n < 2 Then Exit Function
ReDim M(n), X(n), Y(n), L(n), R(n), S(n)
For i = 1 To n
X(i) = inpArr(1, i)
Y(i) = inpArr(2, i)
Next i
D = X(2) - X(1):  E = (Y(2) - Y(1)) / D
For i = 2 To n - 1
H = D: D = X(i + 1) - X(i)
If D = 0 Then D = 0.0001
F = E: E = (Y(i + 1) - Y(i)) / D
L(i) = D / (D + H)
R(i) = 1 - L(i)
S(i) = 6 * (E - F) / (D + H)
Next i
For i = 2 To n - 1
P = 1 / (R(i) * L(i - 1) + 2)
L(i) = -L(i) * P
S(i) = (S(i) - R(i) * S(i - 1)) * P
Next i
M(n) = 0: L(n - 1) = S(n - 1): M(n - 1) = L(n - 1)
For i = n - 2 To 1 Step -1
L(i) = L(i) * L(i + 1) + S(i)
M(i) = L(i)
Next i
PrepareSpline = True
End Function

'***Inter/Extrapolation********

Private Function CalcValue(arg As Single) As Single
Dim ret As Single, i As Integer, n As Integer
Dim D As Single, H As Single, P As Single, R As Single
n = UBound(X)
For i = 1 To n
If arg < X(i) Then Exit For
Next i
Select Case i
Case 1    ' arg less then x(1) -> Extrapolation
D = X(2) - X(1)
If D = 0 Then D = 0.0001
ret = -D * M(2) / 6 + (Y(2) - Y(1)) / D
ret = ret * (arg - X(1)) + Y(1)
Case n + 1 ' arg greater then x(n) -> Extrapolation
D = X(n) - X(n - 1)
If D = 0 Then D = 0.0001
ret = D * M(n - 1) / 6 + (Y(n) - Y(n - 1)) / D
ret = ret * (arg - X(n)) + Y(n)
Case Else  'interpolation
D = X(i) - X(i - 1): H = arg - X(i - 1)
R = X(i) - arg: P = D * D / 6
ret = (M(i - 1) * R ^ 3 + M(i) * H ^ 3) / (6 * D)
ret = ret + ((Y(i - 1) - M(i - 1) * P) * R + (Y(i) - M(i) * P) * H) / D
End Select
CalcValue = ret
End Function

'***How to use - preparing array*****

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
Static n1 As Integer
If bNew Then
n1 = 0
bNew = False
End If
If Button = 1 Then
n1 = n1 + 1
ReDim Preserve TempArr(2, n1)
TempArr(1, n1) = X
TempArr(2, n1) = Y
Text1 = Text1 & vbCrLf & TempArr(1, n1) & vbTab & TempArr(2, n1)
Picture1.Circle (X, Y), 50
End If
End Sub

'Now, just call PrepareSpline function one time and then You can calc any value as many time as you want:

Private Sub Command1_Click()
If PrepareSpline(TempArr) Then
DrawCurve Val(Text2)
Else
MsgBox "Unable to draw curve", vbOKOnly + vbCritical
End If
End Sub

Private Sub DrawCurve(iStep As Integer)
Dim i As Integer
Picture1.PSet (X(LBound(X)), CalcValue(X(LBound(X))))
For i = X(LBound(X)) + iStep To X(UBound(X)) Step iStep
Picture1.Line -(i, CalcValue(CSng(i)))
Next i
End Sub

Cheers
0

Author Commented:
Ark

That looks great and I am sure it would work. However, I don't wish to graph the results just simply place them in the missing places...also, there will be times when there will be consecutive missing data...will this deal with that. Finally , if you wouldn't mind, would you exlain how the above function would work in conjunction with my code, which is below.

Option Explicit

Private Sub CommandButton1_Click()

Dim aSkew() As Double, aSurface() As Double, ValidData() As Double
Dim nctr1 As Integer, nctr2 As Integer, nCtr3 As Integer, nCtr4 As Integer, nLast As Integer
Dim bFlag As Boolean

ActiveCell.Select

Range("input").Clear

nLast = 1
Do While Range("surface").Cells(1, nLast + 1) <> ""
nLast = nLast + 1
Loop

ReDim ValidData(0 To nLast, 0 To 1)
For nctr1 = 1 To nLast
For nctr2 = 1 To nLast
If Range("Surface").Cells(1, nctr1 + 1) = Range("skew").Cells(1, nctr2 + 1) Then
ValidData(nctr2, 0) = nctr1
'Debug.Print nCtr1 & Space(10) & nCtr2 & Space(10) & ValidData(nCtr2, 0)
End If
Next nctr2
Next nctr1

bFlag = False

For nctr1 = 1 To nLast - 1
If nctr1 > 2 Then
bFlag = True
End If
'checks to see if the strike range of the skew and surface are equivalent
For nctr2 = 1 To nLast
If Range("Surface").Cells(1, nctr1 + 1) = Range("skew").Cells(1, nctr2 + 1) Then
'cycles through time periods
For nCtr3 = 1 To 8
If bFlag = True Then
Range("surface").Cells(nCtr3 + 1, ValidData(nctr2, 0) + 1) = _
Range("skew").Cells(nCtr3 + 1, nctr2 + 1) + Range("surface").Cells(nCtr3 + 1, 8)
'Debug.Print Range("skew").Cells(nCtr3 + 1, nCtr2 + 1) & Space(10) & Range("surface").Cells(nCtr1, 8)
ElseIf Range("skew").Cells(1, 2) <= 40 Then
Range("surface").Cells(nCtr3 + 1, 2) _
= Range("skew").Cells(nCtr3 + 1, nctr2 + 1) + Range("surface").Cells(nCtr3 + 1, 8)
'Debug.Print Range("skew").Cells(nCtr3 + 1, nCtr2 + 1) & Space(10) & Range("surface").Cells(nCtr1 + 1, 8)
Else
Range("surface").Cells(nCtr3 + 1, nctr1 + ValidData(nctr1 - 1, 0) - 1) _
= Range("skew").Cells(nCtr3 + 1, nctr2 + 1) + Range("surface").Cells(nCtr3 + 1, 8)
'Debug.Print Range("skew").Cells(nCtr3 + 1, nCtr2 + 1) & Space(10) & Range("surface").Cells(nCtr1, 8)
End If
Next nCtr3
ElseIf Range("Surface").Cells(1, nctr1 + 1) = 100 Then
nctr1 = nctr1 + 1
End If
Next nctr2
Next nctr1

'Call FillInData(nLast)

Range("input").Select
Selection.NumberFormat = "0.000"

End Sub

Dim aFTSE() As Double, aSPX() As Double, aSTOXX() As Double
Dim nctr1 As Integer, nctr2 As Integer

'aVol(index, period, best)
ReDim aFTSE(1 To 4)
ReDim aSPX(1 To 4)
ReDim aSTOXX(1 To 4)

nctr1 = 0

Do While Sheet2.Range("macrolist").Cells(nctr1 + 1, 1) <> ""
'grabs FTSE best from sheet macro
If Sheet2.Range("macrolist").Cells(nctr1 + 1, 1) = ".FTSE" Then
If Sheet2.Range("macrolist").Cells(nctr1 + 1, 3) = 11 Then
nctr1 = nctr1 + 1
nctr2 = nctr2 + 1
End If

For nctr2 = nctr2 To 4
aFTSE(nctr2) = Sheet2.Range("macrolist").Cells(nctr2 + 1, 6)
Next nctr2
nctr2 = 1

ElseIf Sheet2.Range("macrolist").Cells(nctr1 + 1, 1) = ".SPX" Then

For nctr2 = nctr2 To 4
aSPX(nctr2) = Sheet2.Range("macrolist").Cells(nctr2 + 6, 6)
Next nctr2
nctr2 = 1

ElseIf Sheet2.Range("macrolist").Cells(nctr1 + 1, 1) = ".STOXX50E" Then

For nctr2 = nctr2 To 4
aSTOXX(nctr2) = Sheet2.Range("macrolist").Cells(nctr2 + 10, 6)
Next nctr2
nctr2 = 1
Exit Do
End If

nctr1 = nctr1 + 5

Loop

nctr1 = 0

'dumps 100% data onto sheet
For nctr1 = 1 To 4
Range("surface").Cells(nctr1 + 1, 8) = aFTSE(nctr1)
Next nctr1

'loads strike range of skew into array
For nctr1 = 1 To 9
aSkew(nctr1) = Range("skew").Cells(1, nctr1 + 1)
Next nctr1

'loads strike range of surface into array
ReDim aSurface(1 To 17)
For nctr1 = 1 To 17
aSurface(nctr1) = Range("Surface").Cells(1, nctr1 + 1)
Next nctr1

End Function

Private Function FillInData(nLast As Integer)

Dim nctr1 As Integer, nctr2 As Integer, nCtr3 As Integer
Dim aInput() As Variant

ReDim aInput(1 To nLast - 1, 0 To 1)
For nctr1 = 1 To nLast - 1
If Range("input").Cells(1, nctr1) = "" Then
'aInput(nCtr1) = Right(Left(Range("input").Cells(1, nCtr1).Address, 2), 1)
aInput(nctr1, 0) = False
aInput(nctr1, 1) = nctr1
Else
aInput(nctr1, 0) = True
aInput(nctr1, 1) = nctr1
End If
'Debug.Print aInput(nctr1, 0) & Space(10) & aInput(nctr1, 1)
Next nctr1

nctr2 = 1
For nctr1 = 1 To nLast - 1
Do Until aInput(nctr2, 0) = True
nctr2 = nctr2 + 1
Loop
If Not nctr1 = 1 Then
If aInput(nctr1 - 1, 0) = True And aInput(nctr1 + 1, 0) = True Then
Call Interpolate(aInput(), nctr1, nctr2)
Else
Call Extrapolate(aInput(), nctr1, nctr2)
End If
Else
If aInput(1, 0) = True And aInput(nctr1 + 1, 0) = True Then
Call Interpolate(aInput(), nctr1, nctr2)
Else
Call Extrapolate(aInput(), nctr1, nctr2)
End If
End If
Next nctr1

End Function

Private Function Interpolate(aInput(), nctr1, nctr2) As Double

End Function

Private Function Extrapolate(aInput(), nctr1, nctr2) As Double

End Function
0

Author Commented:
0

Commented:
Thanks.

Does this mean your question was answered?  If not, let me know and I'll try to get you through any additional coding--for example, you'll need to add error handling for conditions such as if you don't find a "next value", like
5 6 7 _ _

the value after 7 can't be computed by averaging the 7 and the next number because there is no next number, so you'd have to then go backwards.

Also, the following case could cause problems:

_ _ 7 _ _

Obviously, there is no practical way to determine any of the values, so an error should be generated to show "insufficient info."
0

Author Commented:
Well no, I changed the way I was doing it, but you deserve the points...if you want I can post my code...take a look if you want...maybe you could optomize it for me...seems as though for some crazy reason...by accident I add, I allocated 200 points, when I meant 20, still too late now to cry over it...so if you could think of anyway of speeding up the code then by all means take a look :)

Thanks

ie
0

Author Commented:
and here it is, quite a lot of it.

Code for the worksheet

Option Explicit
Dim sSkew As String

Private Sub CommandButton1_Click()

Dim aSkew() As Double, aSurface() As Double, ValidData() As Double
Dim nCtr1 As Integer, nCtr2 As Integer, nCtr3 As Integer, nCtr4 As Integer, nLast As Integer
Dim n100 As Integer
Dim bFlag As Boolean
Dim dRound As Double

ActiveCell.Select

Range("input").Clear
Range("intermediate").Clear

If sSkew = "" Then
MsgBox "You must select an Index"
Exit Sub
End If

n100 = 1
Do While Range("input").Cells(0, n100) <> 100
n100 = n100 + 1
Loop

nLast = 1
Do While Range("surface").Cells(1, nLast + 1) <> ""
nLast = nLast + 1
Loop

ReDim ValidData(0 To nLast - 1, 0 To 1)
For nCtr1 = 1 To nLast - 1
For nCtr2 = 1 To 8
If Range("Surface").Cells(1, nCtr1 + 1) = Range(sSkew).Cells(1, nCtr2 + 1) Then
ValidData(nCtr2, 0) = nCtr1
End If
Next nCtr2
Next nCtr1

'if strike range isn't in multiples of 10
nCtr1 = 1
Do While Range(sSkew).Cells(1, nCtr1 + 1) <> ""
If ValidData(nCtr1, 0) = 0 Then
dRound = Int(Range(sSkew).Cells(1, nCtr1 + 1) / 10 + 0.5) * 10
Range("skew").Cells(1, nCtr1 + 1) = dRound
Else
Range("skew").Cells(1, nCtr1 + 1) = Range(sSkew).Cells(1, nCtr1 + 1)
End If
nCtr1 = nCtr1 + 1
Loop

'reconfirm ValidData using new Skew
For nCtr1 = 1 To nLast - 1
For nCtr2 = 1 To 8
If Not Range("Skew").Cells(1, nCtr2 + 1) = 100 Then
If Range("Surface").Cells(1, nCtr1 + 1) = Range("skew").Cells(1, nCtr2 + 1) Then
ValidData(nCtr2, 0) = nCtr1
End If
End If
Next nCtr2
Next nCtr1

'interpolate original skew to get new skew in multiples of 10
For nCtr1 = 1 To 8
For nCtr2 = 1 To 8
If nCtr2 = 1 Then
Range("skew").Cells(nCtr1 + 1, nCtr2 + 1) = Interpolate(Range("Skew").Cells(nCtr1, nCtr2 + 1), _
Range(sSkew).Cells(nCtr1, nCtr2 + 1), Range(sSkew).Cells(nCtr1, nCtr2 + 2), _
Range(sSkew).Cells(nCtr1 + 1, nCtr2 + 1), Range(sSkew).Cells(nCtr1 + 1, nCtr2 + 2))
Else
Range("skew").Cells(nCtr1 + 1, nCtr2 + 1) = Interpolate(Range("skew").Cells(nCtr1, nCtr2 + 1), _
Range(sSkew).Cells(nCtr1, nCtr2 + 1), Range(sSkew).Cells(nCtr1, nCtr2 + 2), _
Range(sSkew).Cells(nCtr1 + 1, nCtr2 + 1), Range(sSkew).Cells(nCtr1 + 1, nCtr2 + 2))
End If
Next nCtr2
Next nCtr1

Range("intermediate").Select
Selection.NumberFormat = "0.0000"
With Selection.Font
.Size = 9
End With

bFlag = False

For nCtr1 = 1 To nLast - 1
If nCtr1 > 2 Then
bFlag = True
End If
'checks to see if the strike range of the skew and surface are equivalent
For nCtr2 = 1 To 8
If Range("Surface").Cells(1, nCtr1 + 1) = Range("Skew").Cells(1, nCtr2 + 1) Then
'cycles through time periods
For nCtr3 = 1 To 8
'divide by 100 so vol points turned into %age
If bFlag = True Then
Range("surface").Cells(nCtr3 + 1, ValidData(nCtr2, 0) + 1) = _
(Range("Skew").Cells(nCtr3 + 1, nCtr2 + 1) / 100) + Range("surface").Cells(nCtr3 + 1, n100 + 1)
ElseIf Range("Skew").Cells(1, 2) <= 40 Then
Range("surface").Cells(nCtr3 + 1, 2) _
= (Range("Skew").Cells(nCtr3 + 1, nCtr2 + 1) / 100) + Range("surface").Cells(nCtr3 + 1, n100 + 1)
Else
Range("surface").Cells(nCtr3 + 1, nCtr1 + ValidData(nCtr1 - 1, 0) - 1) _
= (Range("Skew").Cells(nCtr3 + 1, nCtr2 + 1) / 100) + Range("surface").Cells(nCtr3 + 1, n100 + 1)
End If
Next nCtr3
ElseIf Range("Surface").Cells(1, nCtr1 + 1) = 100 Then
nCtr1 = nCtr1 + 1
End If
Next nCtr2
Next nCtr1

Call Data.FillInData(nLast)

Range("input").Select
Selection.NumberFormat = "0.00000"
With Selection.Font
.Size = 9
End With

End Sub

Private Sub CommandButton2_Click()

Dim nCtr1 As Integer, nCtr2 As Integer, nCtr3 As Integer
Dim dPeriods() As Double, dSpots() As Double, dValues() As Double
Dim sUser As String, sIndices As String

sUser = Range("user").Value
sIndices = "." & sSkew

If sSkew = "" Then
MsgBox "You must select an Index"
Exit Sub
End If

Do While Cells(Range("surface").Row + nCtr1 + 1, Range("surface").Column) <> ""
ReDim Preserve dPeriods(nCtr1)
dPeriods(nCtr1) = Cells(Range("surface").Row + nCtr1 + 1, Range("surface").Column)
'Debug.Print "Periods" & Space(10) & dPeriods(nCtr1)
nCtr1 = nCtr1 + 1
Loop

'load strikes & values into array
Do While Cells(Range("surface").Row, Range("surface").Column + nCtr2 + 1) <> ""
ReDim Preserve dSpots(nCtr2), dValues(nCtr1, nCtr2)
dSpots(nCtr2) = Cells(Range("surface").Row, Range("surface").Column + nCtr2 + 1)
Debug.Print "dSpots" & Space(10) & dSpots(nCtr2)
For nCtr3 = 0 To nCtr1 - 1
dValues(nCtr3, nCtr2) = Cells(Range("surface").Row + nCtr3 + 1, Range("surface").Column + nCtr2 + 1)
Debug.Print "dValues" & Space(10) & dValues(nCtr3, nCtr2)
Next
nCtr2 = nCtr2 + 1
Loop

Call Data.SaveData(sIndices, dPeriods(), dSpots(), dValues(), sUser)

End Sub

Public Sub OptButton1_Click()
sSkew = "FTSE"
End Sub

Public Sub OptButton2_Click()
sSkew = "SPX"
End Sub

Public Sub OptButton3_Click()
sSkew = "STOXX50e"
End Sub

Code in the module

Option Explicit

Dim aFTSE() As Double, aSPX() As Double, aSTOXX() As Double
Dim nCtr1 As Integer, nCtr2 As Integer, n100 As Integer
Dim dDiff As Double

ReDim aFTSE(1 To 8)
ReDim aSPX(1 To 8)
ReDim aSTOXX(1 To 8)

nCtr1 = 0

Do While Sheet2.Range("macrolist").Cells(nCtr1 + 1, 1) <> ""
'grabs FTSE best from sheet macro
If Sheet2.Range("macrolist").Cells(nCtr1 + 1, 1) = ".FTSE" Then
'difference between 1 yr implied vol and Best
dDiff = (ArcLive.GetImpliedVolatility(".FTSE", 1, 100) - aFTSE(1))
If Sheet2.Range("macrolist").Cells(nCtr1 + 1, 3) = 11 Then
nCtr1 = nCtr1 + 1
nCtr2 = nCtr2 + 1
End If
For nCtr2 = nCtr2 To 8
If Not nCtr2 > 4 Then
aFTSE(nCtr2) = Sheet2.Range("macrolist").Cells(nCtr2 + 1, 6)
Else
aFTSE(nCtr2) = ArcLive.GetImpliedVolatility(".FTSE", 1, 100) + _
(ArcLive.GetImpliedVolatility(".FTSE", (nCtr2 - 3), 100) - dDiff)
End If
Next nCtr2
nCtr2 = 1
'grabs SPX best from sheet macro
ElseIf Sheet2.Range("macrolist").Cells(nCtr1 + 1, 1) = ".SPX" Then
dDiff = (ArcLive.GetImpliedVolatility(".SPX", 1, 100) - aSPX(1))
For nCtr2 = nCtr2 To 8
If Not nCtr2 >= 4 Then
aSPX(nCtr2) = Sheet2.Range("macrolist").Cells(nCtr2 + 6, 6)
Else
aSPX(nCtr2) = (ArcLive.GetImpliedVolatility(".SPX", nCtr2 - 2, 100) - dDiff)
End If
Next nCtr2
nCtr2 = 1
'grabs STOXX50e best from sheet macro
ElseIf Sheet2.Range("macrolist").Cells(nCtr1 + 1, 1) = ".STOXX50E" Then
dDiff = (ArcLive.GetImpliedVolatility(".STOXX50e", 1, 100) - aSTOXX(1))
For nCtr2 = nCtr2 To 8
If Not nCtr2 >= 4 Then
aSTOXX(nCtr2) = Sheet2.Range("macrolist").Cells(nCtr2 + 10, 6)
Else
aSTOXX(nCtr2) = (ArcLive.GetImpliedVolatility(".STOXX50e", nCtr2 - 2, 100) - dDiff)
End If
Next nCtr2
nCtr2 = 1
Exit Do
End If
nCtr1 = nCtr1 + 5
Loop

nCtr1 = 0

'dumps 100% data onto sheet
Select Case sSkew
Case Is = "FTSE"
For nCtr1 = 1 To 8
Range("surface").Cells(nCtr1 + 1, Strike100Position + 1) = aFTSE(nCtr1)
Next nCtr1
Case Is = "STOXX50e"
For nCtr1 = 1 To 8
Range("surface").Cells(nCtr1 + 1, Strike100Position + 1) = aSTOXX(nCtr1)
Next nCtr1
Case Is = "SPX"
For nCtr1 = 1 To 8
Range("surface").Cells(nCtr1 + 1, Strike100Position + 1) = aSPX(nCtr1)
Next nCtr1
End Select

'loads strike range of skew into array
For nCtr1 = 1 To 9
aSkew(nCtr1) = Range("Skew").Cells(1, nCtr1 + 1) / 100
Next nCtr1

'loads strike range of surface into array
ReDim aSurface(1 To 17)
For nCtr1 = 1 To 17
aSurface(nCtr1) = Range("Surface").Cells(1, nCtr1 + 1)
Next nCtr1

End Function

Public Function FillInData(nLast As Integer)

Dim nCtr1 As Integer, nCtr2 As Integer, nCtr3 As Integer, nCtr4 As Integer
Dim aInput() As Variant
Dim bFlag As Boolean

ReDim aInput(1 To nLast - 1, 0 To 1)
For nCtr1 = 1 To nLast - 1
If Range("input").Cells(1, nCtr1) = "" Then
aInput(nCtr1, 0) = False
aInput(nCtr1, 1) = nCtr1
Else
aInput(nCtr1, 0) = True
aInput(nCtr1, 1) = nCtr1
End If
Next nCtr1

For nCtr1 = 1 To nLast - 1
If aInput(nCtr1, 0) = False Then
nCtr2 = nCtr1
nCtr3 = nCtr1
If nCtr1 = 1 Then           'finds next filled field..returns number of column
Do Until aInput(nCtr2, 0) <> False
nCtr2 = nCtr2 + 1
If nCtr2 = nLast Then  'if gets to end without finding valid data sets next as 0
nCtr2 = 0
Exit Do
End If
Loop
Else
Do Until aInput(nCtr2, 0) <> False  'finds next filled field..returns number of column
nCtr2 = nCtr2 + 1
If nCtr2 = nLast Then   'if gets to end without finding vallid data sets next as 0
nCtr2 = 0
Exit Do
End If
Loop
Do Until aInput(nCtr3, 0) <> False  'finds previously filled field..returns number of column
nCtr3 = Abs(nCtr3 - 1)
If nCtr3 = nLast Then   'if gets to end without finding vallid data sets next as 0
nCtr3 = 0
Exit Do
End If
Loop
End If
If nCtr1 = 1 Then  'checks to see whether interpolation or extrapolation is needed
'extrapolate
nCtr5 = nCtr2
Do Until Range("surface").Cells(2, nCtr5 + 2) <> ""
nCtr5 = nCtr5 + 1
bFlag = True
Loop
If bFlag = True Then
For nCtr4 = 1 To 8
Range("surface").Cells(nCtr4 + 1, nCtr1 + 1).Value = _
Interpolate(Range("surface").Cells(1, nCtr1 + 1), _
Range("surface").Cells(1, nCtr2 + 1), _
Range("surface").Cells(1, nCtr5 + 2), _
Range("surface").Cells(nCtr4 + 1, nCtr2 + 1), _
Range("surface").Cells(nCtr4 + 1, nCtr5 + 2))
Next nCtr4
bFlag = False
Else
For nCtr4 = 1 To 8
Range("surface").Cells(nCtr4 + 1, nCtr1 + 1).Value = _
Interpolate(Range("surface").Cells(1, nCtr1 + 1), _
Range("surface").Cells(1, nCtr2 + 1), _
Range("surface").Cells(1, nCtr2 + 2), _
Range("surface").Cells(nCtr4 + 1, nCtr2 + 1), _
Range("surface").Cells(nCtr4 + 1, nCtr2 + 2))
Next nCtr4
End If
ElseIf nCtr2 = 0 Then
For nCtr4 = 1 To 8
Range("surface").Cells(nCtr4 + 1, nCtr1 + 1).Value = _
Interpolate(Range("surface").Cells(1, nCtr1 + 1), _
Range("surface").Cells(1, nCtr3), _
Range("surface").Cells(1, nCtr3 + 1), _
Range("surface").Cells(nCtr4 + 1, nCtr3), _
Range("surface").Cells(nCtr4 + 1, nCtr3 + 1))
Next nCtr4
Else
'interpolate
For nCtr4 = 1 To 8
Range("surface").Cells(nCtr4 + 1, nCtr1 + 1).Value = _
Interpolate(Range("surface").Cells(1, nCtr1 + 1), _
Range("surface").Cells(1, nCtr3 + 1), _
Range("surface").Cells(1, nCtr2 + 1), _
Range("surface").Cells(nCtr4 + 1, nCtr3 + 1), _
Range("surface").Cells(nCtr4 + 1, nCtr2 + 1))
Next nCtr4
End If
End If
aInput(nCtr1, 0) = True
Next nCtr1

End Function

Public Function SaveData(Index As String, Periods() As Double, Spots() As Double, Values() As Double, User As String)

Dim sCurrency As String

On Error GoTo fail

Select Case Index
Case Is = ".FTSE"
sCurrency = "gbp"
Case Is = ".SPX"
sCurrency = "usd"
Case Is = "STOXX50e"
sCurrency = "eur"
End Select

ArcLive.DeleteUserVolRate Index, User

If Not ArcLive.AddVolRates("VolRates", "Indices", sCurrency, Index, _
Periods(), Spots(), Values(), User) Then GoTo fail
SaveData = True
Exit Function

fail:
MsgBox "Input into ARC failed", vbExclamation
SaveData = False
End Function

0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.