Solved

Interpolation & Extrapolation

Posted on 2001-06-05
9
403 Views
Last Modified: 2008-02-01
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
0
Comment
Question by:ie1978
9 Comments
 
LVL 32

Expert Comment

by:bhess1
Comment Utility
        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
 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
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
  ' read mylist(i)
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
 
LVL 27

Expert Comment

by:Ark
Comment Utility
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 Comment

by:ie1978
Comment Utility
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

Call DataLoad(aSkew(), aSurface())

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

Private Function DataLoad(aSkew, aSurface) As Double

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
ReDim aSkew(1 To 9)
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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:ie1978
Comment Utility
No reply within a day...
0
 
LVL 22

Accepted Solution

by:
rspahitz earned 200 total points
Comment Utility
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
 
LVL 22

Expert Comment

by:rspahitz
Comment Utility
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 Comment

by:ie1978
Comment Utility
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 Comment

by:ie1978
Comment Utility
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

Call Data.DataLoad(aSkew(), aSurface(), sSkew, n100)

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

'load time periods into array
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

Public Function DataLoad(aSkew, aSurface, sSkew, Strike100Position) As Double

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
ReDim aSkew(1 To 9)
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

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now