Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / Programming / September 2007

Tip: Looking for answers? Try searching our database.

Modified McCauley Duration From VBA?

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
PeteCresswell - 17 Sep 2007 16:52 GMT
Typed into a cell, this works:

=MDURATION("1/1/2008", "1/1/2016", ".08", ".09", "2", "1")

But I want to invoke the calc from afar (specifically MS Access VBA).

I can instantiate a copy of Excel, and invoke other routines like
"MIN", but am not having any luck with "MDURATION" and, indeed, it
does not appear in the code completion dropdown for
WorksheetFunction.mDuration

Sounds like I'm out of luck.

Or am I?

For the maschocistically inclined, here's the offending code (which
looks it's best rendered in a monospaced font) - but all I really want
to know is whether or not I can call MDURATION from VBA code and, if
so, what the syntax would be....

--------------------------------------------------------------------------------------------------
Public Function MDURATION_Excel(ByVal theValues As String) As Variant
8000 debugStackPush mModuleName & ": MDURATION_Excel"
8001 On Error GoTo MDURATION_Excel_err

  ' PURPOSE: To invoke MS Excel's "MDURATION" (Modified McCauley
duration) function"
  ' ACCEPTS: A list of values as a string delimintated by commas
  '          The values are:
  '          - Settlement Date
  '          - Maturity Date
  '          - Coupon percent
  '          - Yield percent
  '          - Payment Frequency
  '            0 = 3./360
  '            1 = Actual/Actual
  '            2 = Actual/360
  '            3 = Actual/365
  '            4 = European 30/360

  ' RETURNS: Result of Excel.MDURATION calculation
  '
  ' SAMPLE:
  ' -----------------------------------------
  '  MS Excel's Help e.g.
  '     =MDURATION("1/1/2008", "1/1/2016", ".08", ".09", "2", "1")
  '     5.73567

  '     translated to call syntax for this routine:
  '     ?MDURATION_Excel("1/1/2008, 1/1/2016, .08, .09, 2, 1")

8002 Dim myArray() As String

    Dim i         As Long
    Dim myResult  As Double

8003 If Len(theValues) > 0 Then
8010    If Excel_Start(gExcelApp) = True Then
8011       ParseToArrayOfString theValues, ",",
myArray                 'Put values in format acceptable to Excel
8912       myResult = gExcelApp.WorksheetFunction.mDuration(myArray)
8913       MDURATION_Excel = myResult
8919    End If
8990 Else
8991    MDURATION_Excel = "na"
8999 End If

MDURATION_Excel_xit:
DebugStackPop
On Error Resume Next
Exit Function

MDURATION_Excel_err:
BugAlert True, ""
Resume MDURATION_Excel_xit
End Function

Public Function ParseToArrayOfString(ByVal theStringToBeParsed As
String, ByVal theDelimiter As String, ByRef theArray() As String) As
Long
1000 debugStackPush mModuleName & ": ParseToArrayOfString"
1001 On Error GoTo ParseToArrayOfString_err

  ' PURPOSE: To parse a Delimited string into an array
  ' ACCEPTS: - String to be parsed
  '          - Delimiter between items in the string
  '          - Address of the array that results will be delivered to
  ' RETURNS: The number of items copied to the array  or -1
  '    SETS: The contents of the array specified
  '
  ' CALLING CONVENTION:
  '   ReDim Items(20)
  '   ItemCount = ParseToArrayOfString("this, is, a string,
delimited, by, commas",Items(),",")

1003 Dim P        As Integer
    Dim i        As Integer
    Dim newSize  As Integer

    Const textComparison = 1

1010  If Len(theStringToBeParsed & "") > 0 Then
1020     If theDelimiter = ""
Then                                              'Check for valid
theDelimiteriter
1030       ParseToArrayOfString = -1
1040     Else
1041       If Len(theStringToBeParsed) < 1 Then
1042          ParseToArrayOfString = -1
1043       Else
1050          i = 0
1060          P = InStr(1, theStringToBeParsed, theDelimiter,
textComparison)
1061          If P = 0
Then                                                     'Oops!  Only
one item, no delimiter
1062             i = 1
1063             ReDim Preserve theArray(i)
1064             theArray(0) = theStringToBeParsed
1065          Else
1070             Do While P >
0                                                  'Copy all items
except last
1080                newSize = i + 1
1090                ReDim Preserve theArray(newSize)
1100                theArray(LBound(theArray) + i) = Left$
(theStringToBeParsed, P - 1)
1110                i = i + 1
1120                theStringToBeParsed = Mid$(theStringToBeParsed, P
+ 1)
1130                P = InStr(1, theStringToBeParsed, theDelimiter,
textComparison)
1140             Loop

1150             theArray(LBound(theArray) + i) =
theStringToBeParsed              'Copy Last Item
1160             i = i + 1
1165          End If
1170          ParseToArrayOfString = i
1997       End If
1998     End If
1999 End If

ParseToArrayOfString_xit:
DebugStackPop
On Error Resume Next
Exit Function

ParseToArrayOfString_err:
ParseToArrayOfString = -1
BugAlert True, ""
Resume ParseToArrayOfString_xit
End Function

Public Function Excel_Start(ByRef theSS As Excel.Application) As
Boolean
3000 debugStackPush mModuleName & ": Excel_Start: "
3001 On Error GoTo Excel_Start_err

  ' PURPOSE:  - Start an instance of MS Excel or use an existing
instance
  '           - Leave "theSS" pointing to the Excel Basic engine
  '             behind the newly-opened document
  ' ACCEPTS:  - Pointer to the spreadsheet TB used by calling routine
  ' RETURNS: True/False depending on success
  '
  '   NOTES: 1) We do not want to keep opening up new instances of
Excel every time this routine
  '             is called, so we do the "= Nothing" check to see if
theSS has already been set.
  '             OTHO the user may have closed that instance of Excel,
leaving theSS pointing to
  '             Neverneverland.   Experimentation shows that an error
2753 is generated in this case.
  '             Hence the error trap and the "userClosedExcel"
switch.
  '
  'SAMPLE:
  '        ?SpreadSheetOpenExisting("D:\Dev\SEI\DataSource
\BuySell.xls", gExcelApp)

3002 Dim userClosedExcel  As Long
    Dim serverNotExist   As Long
    Dim okToProceed      As Boolean

    Const oleError = 2753
    Const rpcServerUnavailable = -2147023174
    Const remoteServerNotExist = 462
    Const docAlreadyOpen = 1004

Excel_Start_loop:
  ' ---------------------------------------------------
  ' Create an instance of Excel

3010 If (theSS Is Nothing) Or (userClosedExcel = 1) Then
3011    Set theSS = CreateObject("Excel.Application")
'3012    With theSs
'3013       .Workbooks.Add
'3014       .ScreenUpdating = True
'3015       .Visible = True
'3016    End With
3019 End If

  ' ---------------------------------------------------
  ' Open up the spreadsheet

3999 Excel_Start = True

Excel_Start_xit:
DebugStackPop
On Error Resume Next
Exit Function

Excel_Start_err:
 Select Case Err
   Case 2772
        MsgBox "Unable to locate Microsoft Excel program.  Please
notify your administrator", 16, "Cannot Open MS Excel"
        Resume Excel_Start_xit
   Case oleError, rpcServerUnavailable
        If userClosedExcel = 0 Then
           userClosedExcel = userClosedExcel + 1
           Resume Excel_Start_loop
        Else
           BugAlert True, "Unable to open MS Excel.   Suspect user
may have closed existing instance."
           Resume Excel_Start_xit
        End If
   Case remoteServerNotExist
        If serverNotExist = 0 Then
           serverNotExist = serverNotExist + 1
           Set theSS = Nothing
           Resume Excel_Start_loop
        Else
           BugAlert True, "Unable to open MS Excel.   Suspect user
may have closed existing instance."
           Resume Excel_Start_xit
        End If

   Case docAlreadyOpen
        BugAlert True, ""

   Case Else
        BugAlert True, ""
        Resume Excel_Start_xit
 End Select
 Resume Excel_Start_xit           'Shouldn't be needed, but just in
case.....
End Function
--------------------------------------------------------------------------------------------------
PeteCresswell - 17 Sep 2007 17:26 GMT
> I can instantiate a copy of Excel, and invoke other routines like
> "MIN", but am not having any luck with "MDURATION" and, indeed, it
> does not appear in the code completion dropdown for
> WorksheetFunction.mDuration
>
> Sounds like I'm out of luck.

Needless to say, I still have the option of pushing a formula into a
cell, pushing the arguments into other cells, excuting the formula
cell, and then picking off the result.

But that seems wrong somehow.... at least if there's a direct route
via .WorkSheetFunction...
PeteCresswell - 17 Sep 2007 18:32 GMT
> Needless to say, I still have the option of pushing a formula into a
> cell, pushing the arguments into other cells, excuting the formula
> cell, and then picking off the result.

When I go that way, however, it still throws an error.

I come up with a FormulaR1C1 of something like:
=MDURATION("1/1/2008", "1/1/2016", ".08", ".09", "2", "1")

And, indeed, when I manually paste that into a spreadsheet that I have
created by opening up Excel manually, I get the expected result.

But when I programatically put it into a spreadsheet I have opened via
code, it gives an "Error 2029".

If I copy the exact formula the code has created from the cell it was
created into and paste that into another sheet, it works too.

Can anybody elucidate?
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.