*/
Love this site? Hate it? Leave us some comments.
*/

View \XIRR.FRM

XIRR-Internal rate of return 1.0.0

Submitted By: AlexGutierrez
Rating: starstarstarhalf star (Rate It)


VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form IRR
   Caption         =   "XIRR calculator"
   ClientHeight    =   3675
   ClientLeft      =   180
   ClientTop       =   795
   ClientWidth     =   6720
   Icon            =   "XIRR.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3675
   ScaleWidth      =   6720
   Begin VB.TextBox Text6
      Alignment       =   1  'Right Justify
      BeginProperty Font
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   315
      Left            =   2040
      MaxLength       =   20
      TabIndex        =   10
      Text            =   "Text6"
      Top             =   600
      Visible         =   0   'False
      Width           =   1215
   End
   Begin MSComCtl2.MonthView MonthView1
      Height          =   2370
      Left            =   3960
      TabIndex        =   9
      Top             =   0
      Visible         =   0   'False
      Width           =   2700
      _ExtentX        =   4763
      _ExtentY        =   4180
      _Version        =   393216
      ForeColor       =   -2147483630
      BackColor       =   -2147483633
      Appearance      =   1
      StartOfWeek     =   22609921
      CurrentDate     =   37490
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1
      Height          =   2415
      Left            =   0
      TabIndex        =   8
      Top             =   0
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   4260
      _Version        =   393216
      FixedCols       =   0
      ForeColor       =   -2147483635
   End
   Begin VB.ListBox List2
      Height          =   645
      Left            =   4680
      TabIndex        =   3
      Top             =   3120
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.CommandButton Command1
      Caption         =   "&Calculate"
      Height          =   495
      Left            =   0
      TabIndex        =   1
      Top             =   2520
      Width           =   1335
   End
   Begin VB.ListBox List1
      Height          =   645
      Left            =   4680
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   2400
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.Label Label7
      Caption         =   "Made in Mexico by Alejandro Guti?rrez. This is a freeware program, so it can be copied and used by anyone."
      ForeColor       =   &H8000000D&
      Height          =   975
      Left            =   3960
      TabIndex        =   12
      Top             =   1320
      Width           =   2655
   End
   Begin VB.Label Label6
      Caption         =   $"XIRR.frx":0442
      ForeColor       =   &H8000000D&
      Height          =   1335
      Left            =   3960
      TabIndex        =   11
      Top             =   0
      Width           =   2655
   End
   Begin VB.Label Label5
      Caption         =   "Iterations:"
      Height          =   255
      Left            =   0
      TabIndex        =   7
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Label Label4
      ForeColor       =   &H8000000D&
      Height          =   255
      Left            =   1440
      TabIndex        =   6
      Top             =   3360
      Width           =   2295
   End
   Begin VB.Label Label3
      Caption         =   "Accuracy:"
      Height          =   255
      Left            =   0
      TabIndex        =   5
      Top             =   3120
      Width           =   855
   End
   Begin VB.Label Label2
      ForeColor       =   &H8000000D&
      Height          =   255
      Left            =   1440
      TabIndex        =   4
      Top             =   3120
      Width           =   2295
   End
   Begin VB.Label Label1
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   495
      Left            =   1440
      TabIndex        =   2
      Top             =   2520
      Width           =   2415
   End
   Begin VB.Menu ClearAll
      Caption         =   "Clear &all"
   End
   Begin VB.Menu Menu
      Caption         =   "Menu"
      Visible         =   0   'False
      Begin VB.Menu Insert
         Caption         =   "&Insert"
      End
      Begin VB.Menu Delete
         Caption         =   "&Delete"
      End
   End
End
Attribute VB_Name = "IRR"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public ejex, ejey, ejex2, ejey2

Sub Calculate()
   iterations = 0
   Dim fecha1 As Date, fecha2 As Date
   Dim X1 As Double, X2 As Double, X3 As Double, X4 As Double, X5 As Double
   Dim X6 As Double, X7 As Double, X8 As Double, X9 As Double, X10 As Double
   valor1 = 0
   For X1 = 1 To 10000 Step 1
        tasa = X1
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA < valor1 Then Exit For
    Next X1
    For X2 = X1 To 0.1 Step -0.1
        tasa = X2
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA > valor1 Then Exit For
    Next X2
    For X3 = X2 To X1 Step 0.01
        tasa = X3
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA < valor1 Then Exit For
    Next X3
    For X4 = X3 To X2 Step -0.001
        tasa = X4
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA > valor1 Then Exit For
    Next X4
    For X5 = X4 To X3 Step 0.0001
        tasa = X5
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA < valor1 Then Exit For
    Next X5
    For X6 = X5 To X4 Step -0.00001
        tasa = X6
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA > valor1 Then Exit For
    Next X6
    For X7 = X6 To X5 Step 0.000001
        tasa = X7
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA < valor1 Then Exit For
    Next X7
    For X8 = X7 To X6 Step -0.0000001
        tasa = X8
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA > valor1 Then Exit For
    Next X8
    For X9 = X8 To X7 Step 0.00000001
        tasa = X9
        GoSub Calcula
        If sumA = 0 Then MousePointer = 1: Exit Sub
        If sumA < valor1 Then Exit For
    Next X9
    MousePointer = 1
Exit Sub


Calcula:
    Label1.Caption = Format$(tasa, "###,###.########%")
    iterations = iterations + 1: Label4.Caption = iterations
    List2.Clear
    For X = 0 To List1.ListCount - 1
        If X = 0 Then
            fecha1 = Mid$(List1.List(X), 1, 10)
            List2.AddItem Val(LTrim$(RTrim$(Mid$(List1.List(X), 11, 20))))
          Else
            fecha2 = Mid$(List1.List(X), 1, 10)
            a?os = (fecha2 - fecha1) / 365
            vpn = (Val(LTrim$(RTrim$(Mid$(List1.List(X), 11, 20))))) / ((1 + tasa) ^ a?os)
            List2.AddItem Format$(vpn, "##########.##########")
        End If
    Next X
    sumA = 0
    For X = 0 To List2.ListCount - 1
        sumA = sumA + Val(LTrim$(RTrim$(List2.List(X))))
    Next X
    Label2.Caption = Format$(sumA, "###,###,###.##########")
    Return

End Sub


Sub EraseFields()
    Label1.Caption = ""
    Label2.Caption = ""
    Label4.Caption = ""
End Sub

Sub titles()
    MSFlexGrid1.Cols = 3
    MSFlexGrid1.Rows = 1
    MSFlexGrid1.Rows = 2
    MSFlexGrid1.ColWidth(0) = 300
    MSFlexGrid1.ColWidth(1) = 1200
    MSFlexGrid1.ColWidth(2) = 2000
    MSFlexGrid1.Row = 0
    MSFlexGrid1.Col = 1: MSFlexGrid1.Text = "       Date"
    MSFlexGrid1.Col = 2: MSFlexGrid1.Text = "               Amount"
End Sub

Sub TransferDatesAndFigures()
    'transfers the dates and figures in msflexgrid1 to list1
    List1.Clear
    For X = 1 To MSFlexGrid1.Rows - 1
        MSFlexGrid1.Row = X
        MSFlexGrid1.Col = 1
        If Len(MSFlexGrid1.Text) > 0 Then
                        '123456789012345678901234567890
            TextLine$ = "                              "
            Mid$(TextLine$, 1, 10) = MSFlexGrid1.Text
            MSFlexGrid1.Col = 2
            Mid$(TextLine$, 11, 10) = Val(LTrim$(RTrim$(MSFlexGrid1.Text)))
            List1.AddItem TextLine$
        End If
    Next X
End Sub

Private Sub ClearAll_Click()
    titles
    EraseFields
End Sub

Private Sub Command1_Click()
    MousePointer = 11
    EraseFields
    TransferDatesAndFigures
    'checks
    Addsfigures = 0
    If List1.ListCount = 0 Then
        Message = MsgBox("There are no dates and/or figures. Please enter some dates and amounts and try again", vbCritical)
        MousePointer = 1
        Exit Sub
    End If
    For X = 0 To List1.ListCount - 1
        Addsfigures = Addsfigures + Val(LTrim$(RTrim$(Mid$(List1.List(X), 11, 20))))
    Next X
    If Addsfigures < 0 Then
        Message = MsgBox("The sum of the values is negative so the IRR cannot be calculated. Please try again", vbCritical)
        MousePointer = 1
        Exit Sub
    End If
    'finished checking
    Calculate
    MousePointer = 1
End Sub


Private Sub Command2_Click()

End Sub


Private Sub Delete_Click()
On Error GoTo errorx4:
    If MSFlexGrid1.Rows > 2 Then
        insertanto = 1
        ejey = MSFlexGrid1.Row
       
        textotemporal2$ = ""
        textotemporal2B$ = ""
               
        For Y = MSFlexGrid1.Rows - 2 To ejey Step -1
            MSFlexGrid1.Col = 1
            MSFlexGrid1.Row = Y
            TEXTOTEMPORAL$ = MSFlexGrid1.Text
            MSFlexGrid1.Text = textotemporal2$
            textotemporal2$ = TEXTOTEMPORAL$
           
            MSFlexGrid1.Col = 2
            MSFlexGrid1.Row = Y
            TEXTOTEMPORALB$ = MSFlexGrid1.Text
            MSFlexGrid1.Text = textotemporal2B$
            textotemporal2B$ = TEXTOTEMPORALB$
        Next Y
       
        MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1 'elimina un rengl?n
        MSFlexGrid1.Row = MSFlexGrid1.Rows - 1
        MSFlexGrid1.Col = 0
        MSFlexGrid1.Text = ""
        MSFlexGrid1.Row = ejey
        insertanto = 0
    End If

errorx4:
MousePointer = 1

End Sub

Private Sub Form_Load()
    titles
End Sub

Private Sub Insert_Click()
On Error GoTo errorx5:
    insertanto = 1
    ejey = MSFlexGrid1.Row
    MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
    textotemporal2$ = ""
    textotemporal2B$ = ""
   
    For Y = ejey To MSFlexGrid1.Rows - 2
        MSFlexGrid1.Col = 1
        MSFlexGrid1.Row = Y
        TEXTOTEMPORAL$ = MSFlexGrid1.Text
        MSFlexGrid1.Text = textotemporal2$
        textotemporal2$ = TEXTOTEMPORAL$
   
        MSFlexGrid1.Col = 2
        MSFlexGrid1.Row = Y
        TEXTOTEMPORALB$ = MSFlexGrid1.Text
        MSFlexGrid1.Text = textotemporal2B$
        textotemporal2B$ = TEXTOTEMPORALB$
    Next Y

    MSFlexGrid1.Col = 0
    MSFlexGrid1.Row = ejey
    insertanto = 0
errorx5:

End Sub


Private Sub MonthView1_DateClick(ByVal DateClicked As Date)
    MonthView1.ToolTipText = "Double click with the mouse the date that you want to set"
End Sub

Private Sub MonthView1_DateDblClick(ByVal DateDblClicked As Date)
    On Error GoTo AnError26:
    MSFlexGrid1.Col = 1
    MSFlexGrid1.Text = Format$(MonthView1.Value, "YYYY/MM/DD")
    MonthView1.Visible = False
    MSFlexGrid1.SetFocus
AnError26:

End Sub


Private Sub MonthView1_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error GoTo AnError28:
    If KeyCode = 13 Then
        MSFlexGrid1.Col = 1
        MSFlexGrid1.Text = Format$(MonthView1.Value, "YYYY/MM/DD")
        MonthView1.Visible = False
        MSFlexGrid1.SetFocus
    End If
AnError28:

End Sub

Private Sub MonthView1_LostFocus()
    MonthView1.Visible = False
End Sub


Private Sub MSFlexGrid1_Click()
    If MSFlexGrid1.Row = 0 Then Exit Sub
    saled = 1
    If MSFlexGrid1.Col = 0 Then
        PopupMenu Menu
      Else
        If MSFlexGrid1.Row = MSFlexGrid1.Rows - 1 Then MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
        If MSFlexGrid1.Col = 1 Then
            MonthView1.Visible = True
            If Len(MSFlexGrid1.Text) > 0 Then
                MonthView1.Year = Val(Mid$(MSFlexGrid1.Text, 1, 4))
                MonthView1.Month = Val(Mid$(MSFlexGrid1.Text, 6, 2))
                MonthView1.Day = Val(Mid$(MSFlexGrid1.Text, 9, 2))
              Else
                MonthView1.Value = Now
            End If
            MonthView1.SetFocus
        End If
        If MSFlexGrid1.Col = 2 Then
            Text6.Text = ""
            Text6.Text = MSFlexGrid1.Text
            Text6.Top = MSFlexGrid1.RowPos(MSFlexGrid1.Row) + MSFlexGrid1.Top + 10
            Text6.Left = MSFlexGrid1.ColPos(MSFlexGrid1.Col) + MSFlexGrid1.Left + 10
            Text6.Width = MSFlexGrid1.ColWidth(MSFlexGrid1.Col)
            Text6.Visible = True
            Text6.SetFocus
            ejex = MSFlexGrid1.Row
            ejey = MSFlexGrid1.Col
            MSFlexGrid1.Row = ejex
            MSFlexGrid1.Col = ejey
            vienederaton = 1
        End If
    End If
End Sub


Private Sub MSFlexGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
    If MSFlexGrid1.Row = 0 Then Exit Sub
    saled = 2
    If MSFlexGrid1.Col = 0 Then
        PopupMenu Menu
      Else
        If MSFlexGrid1.Row = MSFlexGrid1.Rows - 1 Then MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
        If MSFlexGrid1.Col = 1 Then
            MonthView1.Visible = True
            If Len(MSFlexGrid1.Text) > 0 Then
                MonthView1.Year = Val(Mid$(MSFlexGrid1.Text, 1, 4))
                MonthView1.Month = Val(Mid$(MSFlexGrid1.Text, 6, 2))
                MonthView1.Day = Val(Mid$(MSFlexGrid1.Text, 9, 2))
              Else
                MonthView1.Value = Now
            End If
            MonthView1.SetFocus
        End If
        If MSFlexGrid1.Col = 2 Then
            Text6.Text = ""
            Text6.Text = MSFlexGrid1.Text
            Text6.Top = MSFlexGrid1.RowPos(MSFlexGrid1.Row) + MSFlexGrid1.Top + 10
            Text6.Left = MSFlexGrid1.ColPos(MSFlexGrid1.Col) + MSFlexGrid1.Left + 10
            Text6.Width = MSFlexGrid1.ColWidth(MSFlexGrid1.Col)
            Text6.Visible = True
            Text6.SetFocus
            ejex = MSFlexGrid1.Row
            ejey = MSFlexGrid1.Col
            MSFlexGrid1.Row = ejex
            MSFlexGrid1.Col = ejey
            If Len(KeyCode) > 1 Then
                If Right$(KeyCode, 2) = 7 Then Text6.Text = "+": GoTo sdfghj6
                If Right$(KeyCode, 2) = 9 Then Text6.Text = "-": GoTo sdfghj6
                If Right$(KeyCode, 2) = 96 Then Text6.Text = "0": GoTo sdfghj6
                If Right$(KeyCode, 2) = 97 Then Text6.Text = "1": GoTo sdfghj6
                If Right$(KeyCode, 2) = 98 Then Text6.Text = "2": GoTo sdfghj6
                If Right$(KeyCode, 2) = 99 Then Text6.Text = "3": GoTo sdfghj6
                If Right$(KeyCode, 2) = 0 Then Text6.Text = "4": GoTo sdfghj6
                If Right$(KeyCode, 2) = 1 Then Text6.Text = "5": GoTo sdfghj6
                If Right$(KeyCode, 2) = 2 Then Text6.Text = "6": GoTo sdfghj6
                If Right$(KeyCode, 2) = 3 Then Text6.Text = "7": GoTo sdfghj6
                If Right$(KeyCode, 2) = 4 Then Text6.Text = "8": GoTo sdfghj6
                If Right$(KeyCode, 2) = 5 Then Text6.Text = "9": GoTo sdfghj6
            End If
            If KeyCode > 47 And KeyCode < 58 Then
                Text6.Text = Chr$(KeyCode)
              Else
                Text6.Text = MSFlexGrid1.Text
                End If
            End If
sdfghj6:
        Text6.SelStart = Len(Text6.Text)
    End If

End Sub


Private Sub Text6_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        MSFlexGrid1.Text = Text6.Text
        Text6.Visible = False
        MSFlexGrid1.SetFocus
    End If
    If KeyCode = vbKeyUp Then
        MSFlexGrid1.Text = Text6.Text
        Text6.Visible = False
        If MSFlexGrid1.Row > 1 Then MSFlexGrid1.Row = MSFlexGrid1.Row - 1
        MSFlexGrid1.SetFocus
    End If
    If KeyCode = vbKeyDown Then
        MSFlexGrid1.Text = Text6.Text
        Text6.Visible = False
        If MSFlexGrid1.Row < MSFlexGrid1.Rows - 1 Then MSFlexGrid1.Row = MSFlexGrid1.Row + 1
        MSFlexGrid1.SetFocus
    End If
End Sub


Private Sub Text6_LostFocus()
    ejex2 = MSFlexGrid1.Row
    ejey2 = MSFlexGrid1.Col
    MSFlexGrid1.Row = ejex
    MSFlexGrid1.Col = ejey
    MSFlexGrid1.Text = Text6.Text
    Text6.Visible = False
    MSFlexGrid1.Row = ejex2
    MSFlexGrid1.Col = ejey2
End Sub

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.