Judging by the size of your ZIP file I'm guessing that you didn't delete the binary files before zipping. Posting binary files is against forum rules so please delete the 'bin' and 'obj' folders before zipping up a project to post.
How about just posting the code that does the math. Many people here don't really want to download zip files of any sort.
here is the entire code:
initializing stuff
Code:
Option Explicit On
Imports System.Threading
Imports System.Data.OleDb
Imports excel = Microsoft.Office.Interop.Excel
Imports VB = Microsoft.VisualBasic
'Declare variables
Dim intMonths As Integer
Dim dblYears As Double
Dim ChangeDayValue As Boolean
Dim DaysAdded As Boolean
Dim FirstRunCompleteDaysAdd As Boolean
Dim intFrequency As Integer
Dim dblRepayment As Double
Dim dblMonthlyPayment As Double
Dim dblRate As Double
Dim dblNumOfPayments As Integer
Dim dblPrincipal As Double
Dim dblConvertInterest As Double 'convert to monthly interest
Dim intPmt As Integer = 1 'initialize integer
Dim currPmt As Integer
Dim prevPmt As Integer
Dim decDeductBalance As Decimal
Dim interestPaid As Decimal
Dim decNewBalance As Decimal
Dim dblTotalPayments As Double
Dim dblInterestToDecimal As Double 'convert interest % to decimal
Dim int_Totals_Interest As Decimal
Dim int_Totals_Principal As Decimal
Dim int_Totals_Repayments As Decimal
This is the button to calc
Code:
Private Sub btnCalculate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCalculate.Click
lblStarted.Text = Now
txttmpOriginalDayValue.Text = dtpStartDate.Value.Day.ToString
ChangeDayValue = False
DaysAdded = False
FirstRunCompleteDaysAdd = False
'get user input
dblPrincipal = Val(txtLoanAmount.Text)
dblRate = Val(txtInterestRate.Text)
dblYears = Val(txtTerm.Text)
'intMonths = Val(txtTerm.Text)
'error check
If txtLoanAmount.Text = "" Then
ErrorProvider1.SetError(txtLoanAmount, "Cannot leave textbox blank")
ElseIf txtInterestRate.Text = "" Then
ErrorProvider1.SetError(txtInterestRate, "Cannot leave textbox blank")
ElseIf txtTerm.Text = "" Then
ErrorProvider1.SetError(txtTerm, "Cannot leave textbox blank")
End If
'error check
If txtLoanAmount.Text <> "" Then
ErrorProvider1.Dispose()
ElseIf txtInterestRate.Text <> "" Then
ErrorProvider1.Dispose()
ElseIf txtTerm.Text <> "" Then
ErrorProvider1.Dispose()
End If
If cbFrequency.SelectedItem.ToString = "Weekly" Then
intFrequency = 52
ElseIf cbFrequency.SelectedItem.ToString = "Fortnightly" Then
intFrequency = 26
ElseIf cbFrequency.SelectedItem.ToString = "Monthly" Then
intFrequency = 12
ElseIf cbFrequency.SelectedItem.ToString = "Quarterly" Then
intFrequency = 4
ElseIf cbFrequency.SelectedItem.ToString = "Semi-annually" Then
intFrequency = 2
ElseIf cbFrequency.SelectedItem.ToString = "Annually" Then
intFrequency = 1
End If
Console.WriteLine("intFrequency: " & intFrequency)
'' interest rate
dblInterestToDecimal = dblRate / 100
Console.WriteLine("dblInterestToDecimal: " & dblInterestToDecimal)
'2. calculate interest
dblConvertInterest = dblInterestToDecimal / intFrequency
Console.WriteLine("dblConvertInterest: " & dblConvertInterest)
'3. calculate the total number of payments (n * 12)
dblNumOfPayments = dblYears * intFrequency
Console.WriteLine("intNumOfPayments: " & dblNumOfPayments)
'4. Calculate monthly payment using formula
dblRepayment = dblPrincipal * dblConvertInterest / (1 - (1 + _
dblConvertInterest) ^ -dblNumOfPayments) 'end monthtly payment
Console.WriteLine("dblRepayment: " & dblRepayment)
txtRepaymentAmount.Text = String.Format("{0:C}", dblRepayment)
dtp_tempDate.Value = dtpStartDate.Value
dtptmpRepaymentDate.Value = Format(dtpStartDate.Value, "dd/MM/yyyy")
' clear the ListBox
lbxOutputListBox.Items.Clear()
dblTotalPayments = dblNumOfPayments * dblRepayment 'total amount of payments
txtTotalRepaid.Text = String.Format("{0:C}", dblTotalPayments)
decNewBalance = dblPrincipal 'initialize principle balance
currPmt = intPmt
prevPmt = intPmt
'lblAmoritzationSchedule.Text = "Pmt #" & ControlChars.Tab & _
' ControlChars.Tab & "Date" & ControlChars.Tab & _
' ControlChars.Tab & "Payment" & ControlChars.Tab & _
' ControlChars.Tab & "Interest" & ControlChars.Tab & _
' ControlChars.Tab & "Principal" & ControlChars.Tab & _
' ControlChars.Tab & "Balance"
txtHeaders.Text = "Pmt #" & ControlChars.Tab & _
ControlChars.Tab & "Date" & ControlChars.Tab & _
ControlChars.Tab & ControlChars.Tab & "Payment" & ControlChars.Tab & _
ControlChars.Tab & "Interest" & ControlChars.Tab & _
ControlChars.Tab & "Principal" & ControlChars.Tab & _
ControlChars.Tab & "Balance"
int_Totals_Interest = Nothing
int_Totals_Principal = Nothing
int_Totals_Repayments = Nothing
Do While intPmt <= dblNumOfPayments
If ChangeDayValue = True Then
If dtp_tempDate.Value <> dtptmpRepaymentDate.Value Then
dtp_tempDate.Value = dtptmpRepaymentDate.Value
End If
ChangeDayValue = False
End If
interestPaid = decNewBalance * dblConvertInterest
decDeductBalance = dblRepayment - interestPaid
decNewBalance = decNewBalance - decDeductBalance
lbxOutputListBox.Items.Add(intPmt & ControlChars.Tab & _
ControlChars.Tab & Format(dtp_tempDate.Value, "dd/MM/yyyy") & ControlChars.Tab & _
ControlChars.Tab & String.Format("{0:C}", dblRepayment) & ControlChars.Tab & _
ControlChars.Tab & String.Format("{0:C}", interestPaid) & ControlChars.Tab & _
ControlChars.Tab & String.Format("{0:C}", decDeductBalance) & _
ControlChars.Tab & ControlChars.Tab & String.Format("{0:C}", decNewBalance))
Console.WriteLine("")
Console.WriteLine("Calc - Payment Date: " & Format(dtp_tempDate.Value, "dd/MM/yyyy"))
If cbFrequency.SelectedItem.ToString = "Weekly" Then
If DaysAdded = True Then
dtp_tempDate.Value = Format(dtptmpDaysAdderDate.Value.AddDays(7), "dd/MM/yyyy")
DaysAdded = False
ElseIf DaysAdded = False Then
dtp_tempDate.Value = Format(dtp_tempDate.Value.AddDays(7), "dd/MM/yyyy")
End If
ElseIf cbFrequency.SelectedItem.ToString = "Fortnightly" Then
If DaysAdded = True Then
dtp_tempDate.Value = Format(dtptmpDaysAdderDate.Value.AddDays(14), "dd/MM/yyyy")
DaysAdded = False
ElseIf DaysAdded = False Then
dtp_tempDate.Value = Format(dtp_tempDate.Value.AddDays(14), "dd/MM/yyyy")
End If
ElseIf cbFrequency.SelectedItem.ToString = "Monthly" Then
dtp_tempDate.Value = Format(dtp_tempDate.Value.AddMonths(1), "dd/MM/yyyy")
ElseIf cbFrequency.SelectedItem.ToString = "Quarterly" Then
dtp_tempDate.Value = Format(dtp_tempDate.Value.AddMonths(4), "dd/MM/yyyy")
ElseIf cbFrequency.SelectedItem.ToString = "Semi-annually" Then
dtp_tempDate.Value = Format(dtp_tempDate.Value.AddMonths(6), "dd/MM/yyyy")
ElseIf cbFrequency.SelectedItem.ToString = "Annually" Then
dtp_tempDate.Value = Format(dtp_tempDate.Value.AddYears(1), "dd/MM/yyyy")
End If
currPmt = intPmt
Call CheckBusinessDay()
If cbFrequency.SelectedItem.ToString <> "Weekly" And cbFrequency.SelectedItem.ToString <> "Fortnightly" Then
dtp_tempDate.Value = New DateTime(dtp_tempDate.Value.Year, dtp_tempDate.Value.Month, txttmpOriginalDayValue.Text)
End If
FirstRunCompleteDaysAdd = False
intPmt += 1
int_Totals_Interest += interestPaid
int_Totals_Principal += decDeductBalance
int_Totals_Repayments += dblRepayment
prevPmt = intPmt - 1
Loop
txtTotals_Interest.Text = Math.Round(int_Totals_Interest, 4)
txtTotals_Principal.Text = Math.Round(int_Totals_Principal, 4)
txtTotals_Repayments.Text = Math.Round(int_Totals_Repayments, 4)
lblFinished.Text = Now
End Sub
Code:
Sub CheckBusinessDay()
Call CheckBusinessDay_Holidays()
Call CheckBusinessDay_Weekend()
End Sub
Sub CheckBusinessDay_Holidays()
Dim conn_OLEDB_excel As New OleDb.OleDbConnection
Dim strpath As String
strpath = txtImport_BusinessDays_FileSource.Text
conn_OLEDB_excel = New OleDbConnection("Provider=microsoft.jet.oledb.4.0; data source='" & strpath & "';Extended Properties=""Excel 8.0;IMEX=1;HDR=YES""")
conn_OLEDB_excel.Open()
Dim tmpStoreEndDate As Date
Dim SQL As String
SQL = "SELECT * FROM [" & txtImport_BusinessDays_SheetName.Text & "]" & _
" WHERE [recognised_holidays] > @StartDate AND [recognised_holidays] <= @EndDate"
Dim command As New OleDbCommand(SQL, conn_OLEDB_excel)
command.Parameters.AddWithValue("@StartDate", dtp_tempDate.Value.AddDays(-1))
command.Parameters.AddWithValue("@EndDate", dtp_tempDate.Value)
Console.WriteLine("")
Console.WriteLine("StartDate: " & dtp_tempDate.Value.AddDays(-1))
Console.WriteLine("EndDate: " & dtp_tempDate.Value)
tmpStoreEndDate = dtp_tempDate.Value
'Dim command As New OleDbCommand("Select * from [" & txtImport_BusinessDays_SheetName.Text & "]" & _
' "WHERE [recognised_holidays]=#" & tmp_SearchDate.ToString("dd/MM/yyyy") & "#", conn_OLEDB_excel)
Dim DataReader As OleDbDataReader = command.ExecuteReader
If DataReader.HasRows = True Then
If cbFrequency.SelectedItem.ToString = "Weekly" Or cbFrequency.SelectedItem.ToString = "Fortnightly" Then
If FirstRunCompleteDaysAdd = False Then
dtptmpDaysAdderDate.Value = dtp_tempDate.Value
DaysAdded = True
FirstRunCompleteDaysAdd = True
End If
End If
dtp_tempDate.Value = dtp_tempDate.Value.AddDays(1) ' Format(dtp_tempDate.Value.AddDays(1), "dd/MM/yyyy")
Call CheckBusinessDay()
'Call CheckBusinessDay_Holidays()
'dtp_tempDate.Value = New DateTime(dtp_tempDate.Value.Year, dtp_tempDate.Value.Month, txttmpOriginalDayValue.Text)
dtptmpRepaymentDate.Value = dtp_tempDate.Value
ChangeDayValue = True
Else
'dtp_tempDate.Value = New DateTime(dtp_tempDate.Value.Year, dtp_tempDate.Value.Month, txttmpOriginalDayValue.Text)
'If ChangeDayValue = True Then
' 'dtp_tempDate.Value = New DateTime(dtp_tempDate.Value.Year, dtp_tempDate.Value.Month, txttmpOriginalDayValue.Text)
' ChangeDayValue = False
'End If
'ChangeDayValue = False
''If dtp_tempDate.Value.Day <> txttmpOriginalDayValue.Text Then
'If currPmt <> intPmt Then
' dtp_tempDate.Value = New DateTime(dtp_tempDate.Value.Year, dtp_tempDate.Value.Month, txttmpOriginalDayValue.Text)
' ' Console.WriteLine("New Date Set: " & dtp_tempDate.Value)
' 'End If
'End If
End If
TextBox1.Text = TextBox1.Text & vbCrLf & _
tmpStoreEndDate
DataReader.Close()
conn_OLEDB_excel.Close()
End Sub
Code:
Sub CheckBusinessDay_Weekend()
Dim conn_OLEDB_excel As New OleDb.OleDbConnection
Dim strpath As String
strpath = txtImport_BusinessDays_FileSource.Text
conn_OLEDB_excel = New OleDbConnection("Provider=microsoft.jet.oledb.4.0; data source='" & strpath & "';Extended Properties=""Excel 8.0;IMEX=1;HDR=YES""")
conn_OLEDB_excel.Open()
Dim SQL As String
SQL = "SELECT * FROM [" & txtImport_BusinessDays_SheetName.Text & "]" & _
" WHERE [weekend_days] = @WeekendDay"
Dim command As New OleDbCommand(SQL, conn_OLEDB_excel)
command.Parameters.AddWithValue("@WeekendDay", dtp_tempDate.Value.DayOfWeek.ToString)
Console.WriteLine("")
Console.WriteLine("WeekendDay: " & dtp_tempDate.Value.DayOfWeek.ToString)
Dim DataReader As OleDbDataReader = command.ExecuteReader
If DataReader.HasRows = True Then
dtp_tempDate.Value = dtp_tempDate.Value.AddDays(1) ' Format(dtp_tempDate.Value.AddDays(1), "dd/MM/yyyy")
Call CheckBusinessDay()
'Call CheckBusinessDay_Holidays()
dtptmpRepaymentDate.Value = dtp_tempDate.Value
ChangeDayValue = True
Else
End If
DataReader.Close()
conn_OLEDB_excel.Close()
End Sub
Code:
Private Sub btnImport_BusinessDays_Browse_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnImport_BusinessDays_Browse.Click
ofdSourcePath.Title = "Select the source file..."
ofdSourcePath.FileName = "Select business days list"
If (ofdSourcePath.ShowDialog() = Windows.Forms.DialogResult.OK) Then
txtImport_BusinessDays_FileSource.Text = ofdSourcePath.FileName.ToString
Dim conn_OLEDB As New OleDb.OleDbConnection
Dim strpath As String
strpath = txtImport_BusinessDays_FileSource.Text
conn_OLEDB = New OleDbConnection("Provider=microsoft.jet.oledb.4.0; data source='" & strpath & "';Extended Properties=""Excel 8.0;IMEX=1;HDR=YES""")
conn_OLEDB.Open()
Dim myTableName = conn_OLEDB.GetSchema("Tables").Rows(0)("TABLE_NAME")
Dim myAdapter As OleDbDataAdapter = New OleDbDataAdapter(String.Format("SELECT * FROM [{0}]", myTableName), conn_OLEDB)
txtImport_BusinessDays_SheetName.Text = myTableName
conn_OLEDB.Close()
End If
End Sub
well, that's the code...
the reason why it calls the CheckHolidays sub is to ensure that the new date (ie, tmpdate.adddays(1) is a valid date) .. so this is where it could become quite tedious...
I can't say anything about the math, but then again, the math appears to be a pretty minor part of the code. There are several points that are ripe for optimisation:
1) Look into Double.TryParse and Integer.TryParse rather than Val. This can handle some of your initial validation quicker, though that will have NO impact on overall performance.
2) You write output to a listbox regularly. This is an expensive thing to do, as the listbox updates its display each time you write something. You can disable the updating by calling (I think the name is) blxOutputListbox.BeginUpdate before the loop begins, and EndUpdate after the loop is completed. This will provide a significant performance boost at the cost that the listbox will remain blank until the run is completed.
3) You keep checking the contents of some selections against strings. String manipulation, even comparisons, are quite slow relative to numeric operations. Therefore, you would see some gain by checking the combobox outside of the loop, and using it to set an integer value. The loop would perform a Select Case on the integer value, which will be faster than doing the same with a string.
4) Probably the biggest hit is your CheckBusinessDay. For the holidays and business days, you open a DB connection and query the database once per loop. Do the holidays change that fast? No. Get that stuff into memory before you even begin the loop, and hold it in a way that the lookup is fast. No single change will be likely to provide a greater benefit than this.
so i'm trying something like this to store the holidays:
Code:
Dim dt_Holidays() As Date
Dim conn_OLEDB_excel As New OleDb.OleDbConnection
Dim strpath As String
strpath = txtImport_BusinessDays_FileSource.Text
conn_OLEDB_excel = New OleDbConnection("Provider=microsoft.jet.oledb.4.0; data source='" & strpath & "';Extended Properties=""Excel 8.0;IMEX=1;HDR=YES""")
conn_OLEDB_excel.Open()
Dim SQL As String
SQL = "SELECT [recognised_holidays] FROM [" & txtImport_BusinessDays_SheetName.Text & "]"
Dim adapter As New OleDbDataAdapter
Dim ds As New DataSet
Dim command As New OleDbCommand(SQL, conn_OLEDB_excel)
adapter.SelectCommand = command
adapter.Fill(ds, "[" & txtImport_BusinessDays_SheetName.Text & "]")
adapter.Dispose()
ReDim dt_Holidays(ds.Tables(0).Rows.Count)
Dim DataReader As OleDbDataReader = command.ExecuteReader
Dim i As Long
i = 1
If DataReader.HasRows = True Then
Do While DataReader.Read
If IsDate(DataReader("recognised_holidays")) = True Then
dt_Holidays(i) = DataReader("recognised_holidays")
Console.WriteLine(dt_Holidays(i))
End If
i += 1
Loop
End If
DataReader.Close()
conn_OLEDB_excel.Close()
so now how do I effectively search for particular dates in the array? =/
This is the third time I've written this response, and I hope it actually posts, this time (computer problems destroyed the other two attempts):
You don't actually have an array that way, you have a datatable, which might even work better, in your case, because searching it has a technique that might be faster...or not. Searching a datatable can be easily accomplished using a DataView. The key is that you can't be creating a new DataView every time you need to search, as that will KILL your performance. Instead, you need to keep the same DataView around all the time. The Datatable gives you a default DataView via the DefaultView property. I believe that this DataView object is not created new everytime you access the property, so it should be good to use in this case, though somebody might correct me on that. To use it, you would do something like this:
ds.Tables(0).DefaultView.RowFilter = "<your date field here> = '" & <your search item here> & "'"
Note that the search item is enclosed in single quotes, which might be pretty hard to see in this post. What this does is filter the rows in the dataview down to just the rows that match your search criteria. You can add on other criteria with AND and OR clauses, but it doesn't sound like you need to in this case.
Having set the rowfilter with that line, you can determine whether ANY rows met the search criteria by checking:
ds.Tables(0).DefaultView.RowCount > 0
(that might be count, rather than RowCount, but you'll find out quickly).
If a row matches your criteria, then things get just a little odd. The rows in the DataView are not in a Rows collection like they are in a Datatable, they are in an Items collection. The fields in the row are ALSO in an Items collection, so if a row matches your criteria, you would access an item from that row with something like this:
ds.Tables(0).DefaultView.Item(0).Item(<whatever field you want here?)
sorry i've only recently been able to work on this module again..
I'm trying the following, yet it doesn't work.. not sure if i'm filling the dataset correctly:
Code:
Dim conn_OLEDB_excel As New OleDb.OleDbConnection
Dim strpath As String
strpath = txtImport_BusinessDays_FileSource.Text
conn_OLEDB_excel = New OleDbConnection("Provider=microsoft.jet.oledb.4.0; data source='" & strpath & "';Extended Properties=""Excel 8.0;IMEX=1;HDR=YES""")
conn_OLEDB_excel.Open()
Dim SQL As String
SQL = "SELECT [recognised_holidays] FROM [" & txtImport_BusinessDays_SheetName.Text & "]"
Dim adapter As New OleDbDataAdapter
Dim ds As New DataSet
Dim command As New OleDbCommand(SQL, conn_OLEDB_excel)
adapter.SelectCommand = command
adapter.Fill(ds, "[" & txtImport_BusinessDays_SheetName.Text & "]")
'adapter.Dispose()
'command.Dispose()
'MsgBox("Number of row(s) - " & ds.Tables(0).Rows.Count)
ds.Tables(0).DefaultView.RowFilter = "recognised_holidays='" & dtp_tempDate.Value.ToString & "'"
If ds.Tables(0).DefaultView.Count > 0 Then
Console.WriteLine("Holiday date")
End If
How to optimise my algorthims
Reply With Quote
Originally Posted by lianp
