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