How to generate all combinations of partitioning a string in VB.Net - vb.net

Given a string, how do you generate all partitions of it (shown as smaller strings separated by commas)?
Also, what is the total number of partitions for a string of length n?
The following will give the result, but is not good on long strings.
String: CODE
C,O,D,E
C,O,DE
C,OD,E
C,ODE
CO,D,E
CO,DE
COD,E
String: PEACE
P,E,A,C,E
P,E,A,CE
P,E,AC,E
P,E,ACE
P,EA,C,E
P,EA,CE
P,EAC,E
PE,A,C,E
PE,A,CE
PE,AC,E
PE,ACE
PEA,C,E
PEA,CE
Sub getAllComb()
oriStr = TextBox1.Text
Dim tmp = ""
Dim k = 0
For i = 0 To oriStr.Length
For j = 1 To 3
'tmp = Mid(oriStr, i, j)
Try
tmp1(k) = oriStr.Substring(i, j)
k = k + 1
'tmp = oriStr.Substring(i, j)
'Debug.Print(tmp)
Catch ex As Exception
'Debug.Print("Error>>>>" + ex.Message)
Exit For
End Try
Next
Next
tmp = ""
For i = 0 To k
Debug.Print(i.ToString + "<i " + tmp1(i))
tmp = tmp & tmp1(i) & vbCrLf
Next
'MessageBox.Show(tmp)
Dim tmpAll1 = ""
tmpAll1 = addFunclen4(k)
MessageBox.Show(tmpAll1)
Debug.Print(tmpAll1)
TextBox1.Text = oriStr & vbCrLf & vbCrLf & tmpAll1
End Sub
Function addFunclen4(k As Integer) As String
Dim retVal = ""
Dim tmp = ""
Dim tmpAll = ""
Dim tmpStr = ""
Dim tmpAll1 = ""
For i = 0 To k
For i1 = 0 To k
For i2 = 0 To k
For i3 = 0 To k
For i4 = 0 To k
tmp = Form1.tmp1(i) + Form1.tmp1(i1) + Form1.tmp1(i2) + Form1.tmp1(i3) + Form1.tmp1(i4)
If Form1.tmp1(i) <> "" Then
If tmp = Form1.oriStr Then
tmpStr = Form1.tmp1(i) + "," + Form1.tmp1(i1) + "," + Form1.tmp1(i2) + "," + Form1.tmp1(i3) + "," + Form1.tmp1(i4)
Do While tmpStr.Contains(",,") = True
tmpStr = Replace(tmpStr, ",,", ",")
Loop
If Mid(tmpStr, tmpStr.Length, 1) = "," Then
tmpStr = Mid(tmpStr, 1, tmpStr.Length - 1)
End If
If tmpAll1.Contains(tmpStr) = False Then
tmpAll1 = tmpAll1 + tmpStr + vbCrLf
End If
End If
End If
Next
Next
Next
Next
Next
retVal = tmpAll1
Return retVal
End Function

I reckon [2^(n-1) - 1] in total:
(n-1) positions to put a comma, 2 "states" (comma or not comma), -1 for the trivial case with no commas.
A simpler algorithm would be to iterate through the number of cases and use the binary representation to determine whether to put a comma in each position.
For example (simple form with TextBox, Button and ListBox):
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ListBox1.Items.Clear()
Dim s As String = TextBox1.Text
If s.Length < 2 Then
MessageBox.Show("Enter a longer string")
Return
End If
For i = 1 To Math.Pow(2, s.Length - 1) - 1
Dim result As String = s(0)
For j = 1 To s.Length - 1
result = result & CommaOrNot(i, j) & s(j)
Next
ListBox1.Items.Add(result)
Next
End Sub
Private Function CommaOrNot(i As Integer, j As Integer) As String
If (i And Math.Pow(2, j - 1)) = Math.Pow(2, j - 1) Then
Return ","
Else
Return ""
End If
End Function

I really liked Fruitbat's approach. Here's an alternate version using a slightly different mechanism for the representation of the binary number and how to determine if the comma should be included or not:
Public Class Form1
Private combinations As List(Of String)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim s As String = TextBox1.Text
If s.Length < 2 Then
MessageBox.Show("Enter a longer string")
Exit Sub
End If
Button1.Enabled = False
ListBox1.DataSource = Nothing
ListBox1.Items.Clear()
ListBox1.Items.Add("Generating combinations...")
BackgroundWorker1.RunWorkerAsync(s)
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Dim s As String = e.Argument
Dim combinations As New List(Of String)
Dim binary() As Char
Dim values() As Char = s.ToCharArray
Dim max As Integer = Convert.ToInt32(New String("1", s.Length - 1), 2)
Dim sb As New System.Text.StringBuilder
For i As Integer = 0 To max
sb.Clear()
binary = Convert.ToString(i, 2).PadLeft(values.Length, "0").ToCharArray
For j As Integer = 0 To values.Length - 1
sb.Append(If(binary(j) = "0", "", ","))
sb.Append(values(j))
Next
combinations.Add(sb.ToString)
Next
e.Result = combinations
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
combinations = e.Result
ListBox1.Items.Clear()
ListBox1.Items.Add("Generating combinations...Done!")
ListBox1.Items.Add("Adding Results...one moment please!")
Application.DoEvents()
ListBox1.DataSource = Nothing
ListBox1.DataSource = combinations
Button1.Enabled = True
MessageBox.Show("Done!")
End Sub
End Class

Related

VB service export SQL to CSV

I have created a service that is supposed to pass data from SQL to CSV, by creating a CSV file. It has no errors, but i run it and nothing happens.
1) Is there something I am missing?
2) If it works, and i want to convert to txt file, is it enough to change the "CSV" to "txt" parts?
My code:
#Region "Export SQL TO CSV"
Public Shared Function WriteCSV(ByVal input As String) As String
Try
If (input Is Nothing) Then
Return String.Empty
End If
Dim containsQuote As Boolean = False
Dim containsComma As Boolean = False
Dim len As Integer = input.Length
Dim i As Integer = 0
Do While ((i < len) _
AndAlso ((containsComma = False) _
OrElse (containsQuote = False)))
Dim ch As Char = input(i)
If (ch = Microsoft.VisualBasic.ChrW(34)) Then
containsQuote = True
ElseIf (ch = Microsoft.VisualBasic.ChrW(44)) Then
containsComma = True
End If
i = (i + 1)
Loop
If (containsQuote AndAlso containsComma) Then
input = input.Replace("""", """""")
End If
If (containsComma) Then
Return """" & input & """"
Else
Return input
End If
Catch ex As Exception
Throw
End Try
End Function
Private Sub ExtoCsv(ByVal sender As Object, ByVal e As EventArgs)
Dim sb As StringBuilder = New StringBuilder
Using db As Database.RecordSet = admin.Database.OpenRecordsetReadOnly("select USERID, NAME1 from usertable WHERE I_ID=2")
Dim userid As String = db("USERID").Value
Dim name1 As String = db("NAME1").Value
For i As Integer = 1 To db.RecordCount
sb.Append(WriteCSV(userid + "," + name1 + ","))
sb.AppendLine()
db.MoveNext()
Next
End Using
File.WriteAllText("C:\Users\user1\Desktop\ex1.csv", sb.ToString)
If (Not System.IO.Directory.Exists("C:\Users\user1\Desktop\ex1")) Then
System.IO.Directory.CreateDirectory("C:\Users\user1\Desktop\ex1")
End If
End Sub
#End Region

Find and highlight the max value in from multiple column in VB.net

Hi i need anyone to help me,
I need to highlight the highest value from multiple column in table
For Ex:-
I have try out some coding..
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
UIUtility = New UIUtility()
Dim dtStartProcessTime As DateTime
Dim dtEndProcessTime As DateTime
Dim dtStartQueryTime As DateTime
Dim dtEndQueryTime As DateTime
Dim tsQueryTime As TimeSpan
Dim tsProcessTime As TimeSpan
Dim strCassList As String = ""
Dim dtDefectInfo As New DataTable
Dim dtDefectList As New DataTable
Dim dtResult As New DataTable
Dim dtSelectDefectInfo As New DataTable
Dim strCass_id As String = ""
Dim dtDisplay As New DataTable
Try
dtStartProcessTime = Now
Me.Title = "Shipping Cassettes List"
Dim sEvent_date As String = Request.QueryString("Event_date").Trim()
Dim sRecipe As String = Request.QueryString("recipe").Trim()
Dim sOperation As String = Request.QueryString("operation").Trim()
Dim sEquipment As String = Request.QueryString("equipment").Trim()
lblStatus.Text = "Event_date:" + sEvent_date + _
"<br>Recipe:" + sRecipe + _
"<br>Operation:" + sOperation + _
"<br>Equipment:" + sEquipment + _
"<br><br>"
Dim dtCass As DataTable
Dim drNew As DataRow
Dim SelectDefectInfo As DataRow()
dtStartQueryTime = Now
dtCass = UIUtility.RetrieveShipCassette(sEvent_date, sRecipe, sOperation, sEquipment)
If dtCass.Rows.Count > 0 Then
strCassList = UIUtility.ReturnStringFromdt(dtCass, "shipping_cass_id")
dtDefectInfo = UIUtility.RetrieveDefectInfo(strCassList)
dtDefectList = UIUtility.dtView(dtDefectInfo, "defect")
dtResult.Columns.Add("cass_id", Type.GetType("System.String"))
For i = 0 To dtDefectList.Rows.Count - 1
If Not (dtDefectList.Rows(i).Item("defect").ToString().Equals("NON")) Then
dtResult.Columns.Add(dtDefectList.Rows(i).Item("defect"), Type.GetType("System.Int32")).DefaultValue = 0
End If
Next
For i = 0 To dtCass.Rows.Count - 1
drNew = dtResult.NewRow
strCass_id = dtCass.Rows(i).Item("shipping_cass_id")
drNew("cass_id") = dtCass.Rows(i).Item("cass_id")
SelectDefectInfo = dtDefectInfo.Select("dest_cass_id = '" + strCass_id + "'")
dtSelectDefectInfo = New DataTable
If SelectDefectInfo.Count > 0 Then
dtSelectDefectInfo = SelectDefectInfo.CopyToDataTable
For j = 0 To dtSelectDefectInfo.Rows.Count - 1
If Not (dtSelectDefectInfo.Rows(j).Item("defect").ToString().Trim().Equals("NON")) Then
drNew(dtSelectDefectInfo.Rows(j).Item("defect").ToString()) = dtSelectDefectInfo.Rows(j).Item("defect_count").ToString()
End If
Next
End If
dtResult.Rows.Add(drNew)
Next
End If
dtEndQueryTime = Now
tsQueryTime = dtEndQueryTime.Subtract(dtStartQueryTime)
'For i As Integer = 0 To dtCass.Rows.Count - 1
' drDisplay = dtDisplay.NewRow
' drDisplay("cass_id") = dtCass.Rows(i)("cass_id").ToString()
' dtDisplay.Rows.Add(drDisplay)
' 'dtCass.Rows(i).Item(
'Next
'e.Row.BorderWidth = 2
dgSummary.DataSource = Nothing
dgSummary.DataSource = dtResult
dgSummary.DataBind()
lblStatus.Text += "Total " + dtResult.Rows.Count.ToString + " rows of data found."
dtEndProcessTime = Now
tsProcessTime = dtEndProcessTime.Subtract(dtStartProcessTime)
lblProcessingTime.Text = "Processing Time: " + tsProcessTime.TotalSeconds.ToString + " Secs (Query Time: " + tsQueryTime.TotalSeconds.ToString + " Secs)"
For Each r As GridViewRow In dtResult.Rows()
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Text, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Text = max Then
r.Cells(i).BackColor = Drawing.Color.Orange
Exit For
End If
Next
Next
Catch ex As Exception
lblMessage.Text = "An error occured:" + ex.Message + " Please contact your administrator."
MyLog.WriteToLog(Me.GetType().Name(), System.Reflection.MethodInfo.GetCurrentMethod().Name, "Exception occured." & vbCrLf & "Error Message:" & ex.Message & vbCrLf & " StackTrace:" & ex.StackTrace)
End Try
End Sub
Protected Sub dgSummary_RowDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles dgSummary.RowDataBound
Dim cass_id As String = ""
'Dim dtResult As New DataTable
'Dim DataGridView1 As New DataTable
Dim dtCass As New DataTable
If e.Row.RowType = DataControlRowType.DataRow Then
cass_id = e.Row.Cells(0).Text.Trim
If Not e.Row.Cells(0).Text.Trim.Equals("") Then
e.Row.Cells(0).Attributes.Add("Title", "Click and view the cassette details")
e.Row.Cells(0).Attributes("onmouseover") = "this.style.color='DodgerBlue';this.style.cursor='hand';"
e.Row.Cells(0).Attributes("onmouseout") = "this.style.color='Black';"
e.Row.Cells(0).Attributes("onClick") = _
String.Format("window.open('{0}','_blank','scrollbars=yes,status=yes,location=yes,toolbar=yes,menubar=yes,resizable=Yes')", _
ResolveUrl(System.Configuration.ConfigurationManager.AppSettings("SFEHReportLink_SSL") + cass_id))
e.Row.Cells(0).Style("cursor") = "pointer"
End If
End Sub
Maybe theres any coding that more easier than this since i have 17items
Thank you so much for you guys help.
After i add the new code, i got this error,
new error
maybe this example can help you
Private Sub Button6_Click(sender As Object, e As EventArgs) Handles Button6.Click
For Each r As DataGridViewRow In DataGridView1.Rows
Dim max As Integer = Integer.MinValue
For i = 1 To r.Cells.Count - 1
Dim n As Integer
If Integer.TryParse(CType(r.Cells(i).Value, String), n) Then max = Math.Max(n, max)
Next
For i = 1 To r.Cells.Count - 1
If r.Cells(i).Value = max Then
r.Cells(i).Style.BackColor = Color.Orange
Exit For
End If
Next
Next
End Sub

RichTextBox flikers when syntax highlight

I am writing an IDE an while working on syntax highlighting, i've encountered a very annoying issue.
When I type something, the text flickers...
Here is my code:
Dim KeyWords As List(Of String) = New List(Of String)(New String() {"void", "int", "long", "char", "short", "unsigned", "signed", "#include", "#define", "return"})
Dim KeyWordsColors As List(Of Color) = New List(Of Color)(New Color() {Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Purple, Color.Olive, Color.Olive, Color.Blue})
Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
Dim words As IEnumerable(Of String) = RichTextBox1.Text.Split(New Char() {" "c, ".", ",", "?", "!", "(", Chr(13), Chr(10), " "})
Dim index As Integer = 0
Dim rtb As RichTextBox = sender 'to give normal color according to the base fore color
For Each word As String In words
'If the list contains the word, then color it specially. Else, color it normally
'Edit: Trim() is added such that it may guarantee the empty space after word does not cause error
coloringRTB(sender, index, word.Length, If(KeyWords.Contains(word.ToLower().Trim()) Or KeyWords.Contains("<"), KeyWordsColors(KeyWords.IndexOf(word.ToLower().Trim())), rtb.ForeColor))
index = index + word.Length + 1 '1 is for the whitespace, though Trimmed, original word.Length is still used to advance
Next
Dim strings() As String = RichTextBox1.Text.Split(Chr(34))
Dim count As Integer = 0
Dim cpart As Integer = 0
For Each part In strings
cpart = cpart + 1
If cpart Mod 2 = 0 Then
coloringRTB(RichTextBox1, count - 1, part.Length + 2, Color.Olive)
End If
count = count + part.Length + 1
Next
Dim strings2() As String = RichTextBox1.Text.Split(New Char() {"<", ">"})
count = 0
cpart = 0
For Each part In strings2
cpart = cpart + 1
If cpart Mod 2 = 0 Then
coloringRTB(RichTextBox1, count - 1, part.Length + 2, Color.Olive)
End If
count = count + part.Length + 1
Next
End Sub
Private Sub coloringRTB(rtb As RichTextBox, index As Integer, length As Integer, color As Color)
Dim selectionStartSave As Integer = rtb.SelectionStart 'to return this back to its original position
rtb.SelectionStart = index
rtb.SelectionLength = length
rtb.SelectionColor = color
rtb.SelectionLength = 0
rtb.SelectionStart = selectionStartSave
rtb.SelectionColor = rtb.ForeColor 'return back to the original color
End Sub
Private Sub RichTextBox1_KeyUp(sender As Object, e As KeyPressEventArgs) Handles RichTextBox1.KeyPress
If e.KeyChar = "{"c Then
RichTextBox1.SelectedText = "{}"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("{") + 1
e.Handled = True
End If
If e.KeyChar = "("c Then
RichTextBox1.SelectedText = "()"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("(") + 1
e.Handled = True
End If
If e.KeyChar = "["c Then
RichTextBox1.SelectedText = "[]"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("[") + 1
e.Handled = True
End If
If e.KeyChar = "'"c Then
RichTextBox1.SelectedText = "''"
RichTextBox1.SelectionStart = RichTextBox1.Text.Substring(0, RichTextBox1.SelectionStart).LastIndexOf("'")
e.Handled = True
End If
Dim currentLength = RichTextBox1.Text.Length
End Sub
hope someone can help Thanks ^_^
RichTextBox1 is the richtextbox

Duplicating items on listbox

I have a program that records homework in a list box, and sorts it by the date it is due. However, when I try to sort the data by date, it does so, but duplicates each item in the list box. This can be rectified by closing the program and opening it again, but this is very inconvenient. Is there any way to fix this?
Here is the code for the two
frmSplashScreen:
Imports System.IO
Public Class frmSplashscreen
Dim dates() As Date = {}
Dim temparray() As String = {}
Dim temparray2() As String = {}
Dim Path As String = Application.StartupPath
Dim newuser As Boolean = False
Dim sorted As Boolean = False
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
If lstDate.Items.Contains("No assignments yet!") Then
lstDate.Items.Clear()
End If
frmAdd.Show()
Me.Hide()
End Sub
Private Sub Me_mouseenter(sender As Object, e As EventArgs) Handles Me.MouseEnter
If sorted = False And lstDate.Items.Contains("No assignments yet!") = False Then
SortByDate()
End If
End Sub
Private Sub frmSplashscreen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If File.Exists(Path & "Assignments.crw") = False Then
newuser = True
lstDate.Items.Add("No assignments yet!")
Else
FileOpen(1, Path & "Assignments.crw", OpenMode.Input)
While Not EOF(1)
Dim output As String = LineInput(1)
lstAssignments.Items.Add(Mid(output, InStr(output, "-") + 1, InStr(output, "_") - (InStr(output, "-") + 1)))
lstAN.Items.Add(Mid(output, InStr(output, "_") + 1, output.Length))
lstDate.Items.Add(Mid(output, 1, InStr(output, "-") - 1))
Array.Resize(temparray, temparray.Length + 1)
temparray(temparray.Length - 1) = output
End While
End If
FileClose(1)
If lstDate.Items.Contains("No assignments yet!") = False Then
SortByDate()
End If
End Sub
Private Sub SortByDate()
For Each x In lstDate.Items
MsgBox(x)
Array.Resize(dates, dates.Length + 1)
dates(dates.Length - 1) = x
Next
Array.Sort(dates)
' Sort dates.
temparray2 = {}
' Empty temparray2 for resizing
Dim counter As Integer = 0
' Declare counter
For Each x In dates
' Looping through dates...
Dim result As Integer
' ...Declare result.
For Each y In temparray
' Nestled for loop to check each result against one another. This time looping through temparray.
result = InStr(y, x)
' Search for x (The date) in y (the line of the file)
If result <> 0 Then
' If it is found...
Array.Resize(temparray2, temparray2.Length + 1)
counter = counter + 1
temparray2(counter - 1) = y
' Add y to the array temparray2 in chronological order.
End If
Next
Next
Dim num As Integer = 0
' Declare num
lstAN.Items.Clear()
lstAssignments.Items.Clear()
lstDate.Items.Clear()
temparray = {}
lstAN.Items.Clear()
lstAssignments.Items.Clear()
lstDate.Items.Clear()
For Each x In temparray2
Array.Resize(temparray, temparray2.Length)
temparray(num) = x
lstAssignments.Items.Add(Mid(x, InStr(x, "-") + 1, InStr(x, "_") - (InStr(x, "-") + 1)))
lstAN.Items.Add(Mid(x, InStr(x, "_") + 1, x.Length))
lstDate.Items.Add(Mid(x, 1, InStr(x, "-") - 1))
num += 1
Next
' Loop through temparray2 making temparray the exact same and adding the array to the listbox.
sorted = True
End Sub
Private Sub SortMyLife()
If File.Exists(Path & "Assignments.crw") = False Then
newuser = True
lstDate.Items.Add("No assignments yet!")
Else
FileOpen(1, Path & "Assignments.crw", OpenMode.Input)
While Not EOF(1)
Dim output As String = LineInput(1)
lstAssignments.Items.Add(Mid(output, InStr(output, "-") + 1, InStr(output, "_") - (InStr(output, "-") + 1)))
lstAN.Items.Add(Mid(output, InStr(output, "_") + 1, output.Length))
lstDate.Items.Add(Mid(output, 1, InStr(output, "-") - 1))
Array.Resize(temparray, temparray.Length + 1)
temparray(temparray.Length - 1) = output
End While
End If
FileClose(1)
If lstDate.Items.Contains("No assignments yet!") = False Then
SortByDate()
End If
End Sub
Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged
If CheckBox1.Checked = True Then
Call SortMyLife()
CheckBox1.Checked = False
End If
End Sub
End Class
frmAdd (for adding a new assignment)
Public Class frmAdd
Dim temparray() As String = {}
Dim temparray2() As String = {}
Dim dates() As Date = {}
Dim sorted As Boolean
Private Sub btnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
Dim datedue As Date = dtpDue.Text
Dim Subject As String = cbxSbjct.Text
Dim Additional As String = rtfAN.Text
Dim Path As String = Application.StartupPath & "Assignments.crw"
If datedue > Now() Then
If Subject <> "Choose a subject" Then
FileOpen(1, Path, OpenMode.Append)
Dim output As String = dtpDue.Text & "-" & Subject & "_" & Additional
If frmSplashscreen.lstAssignments.Items.Contains("No assignments yet!") Then
frmSplashscreen.lstAssignments.Items.Clear()
frmSplashscreen.lstDate.Items.Clear()
frmSplashscreen.lstAN.Items.Clear()
End If
frmSplashscreen.lstAssignments.Items.Add(Mid(output, InStr(output, "-") + 1, InStr(output, "_") - (InStr(output, "-") + 1)))
frmSplashscreen.lstAN.Items.Add(Mid(output, InStr(output, "_") + 1, output.Length))
frmSplashscreen.lstDate.Items.Add(dtpDue.Text)
PrintLine(1, output)
FileClose(1)
For Each x In frmSplashscreen.lstDate.Items
MsgBox(x)
Next
Me.Close()
frmSplashscreen.Show()
Else
MsgBox("Please enter a subject in the box provided")
End If
Else
MsgBox("Please enter a date in the future", vbInformation, "Error")
End If
End Sub
End Class
Thank you for the help!
Have you tried something as simple as ListBoxHoliday.Items.Clear before the sort happens?

vb.net - Why do I get this error when trying to bubble sort a csv file?

I have a csv file which I'm trying to sort by data (numerical form)
The csv file:
date, name, phone number, instructor name
1308290930,jim,041231232,sushi
123123423,jeremy,12312312,albert
The error I get is: Conversion from string "jeremy" to type 'double'is not valid
Even though no where in my code I mention double...
My code:
Public Class Form2
Dim currentRow As String()
Dim count As Integer
Dim one As Integer
Dim two As Integer
Dim three As Integer
Dim four As Integer
'concatenation / and operator
'casting
Dim catchit(100) As String
Dim count2 As Integer
Dim arrayone(4) As Decimal
Dim arraytwo(4) As String
Dim arraythree(4) As Decimal
Dim arrayfour(4) As String
Dim array(4) As String
Dim bigstring As String
Dim builder As Integer
Dim twodata As Integer
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Using MyReader As New Microsoft.VisualBasic.FileIO.TextFieldParser("D:\completerecord.txt")
MyReader.TextFieldType = FileIO.FieldType.Delimited
MyReader.SetDelimiters(",")
Dim currentRow As String()
Dim count As Integer
Dim currentField As String
count = 0
While Not MyReader.EndOfData
Try
currentRow = MyReader.ReadFields()
For Each currentField In currentRow
' makes one array to contain a record for each peice of text in the file
'MsgBox(currentField) '- test of Field Data
' builds a big string with new line-breaks for each line in the file
bigstring = bigstring & currentField + Environment.NewLine
'build two arrays for the two columns of data
If (count Mod 2 = 1) Then
arraytwo(two) = currentField
two = two + 1
'MsgBox(currentField)
ElseIf (count Mod 2 = 0) Then
arrayone(one) = currentField
one = one + 1
ElseIf (count Mod 2 = 2) Then
arraythree(three) = currentField
three = three + 1
ElseIf (count Mod 2 = 3) Then
arrayfour(four) = currentField
four = four + 1
End If
count = count + 1
'MsgBox(count)
Next
Catch ex As Microsoft.VisualBasic.FileIO.MalformedLineException
MsgBox("Error Occured, Please contact Admin.")
End Try
End While
End Using
RichTextBox1.Text = bigstring
' MsgBox("test")
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim NoMoreSwaps As Boolean
Dim counter As Integer
Dim Temp As Integer
Dim Temp2 As String
Dim listcount As Integer
Dim builder As Integer
Dim bigString2 As String = ""
listcount = UBound(arraytwo)
'MsgBox(listcount)
builder = 0
'bigString2 = ""
counter = 0
Try
'this should sort the arrays using a Bubble Sort
Do Until NoMoreSwaps = True
NoMoreSwaps = True
For counter = 0 To (listcount - 1)
If arraytwo(counter) > arraytwo(counter + 1) Then
NoMoreSwaps = False
If arraytwo(counter + 1) > 0 Then
Temp = arraytwo(counter)
Temp2 = arrayone(counter)
arraytwo(counter) = arraytwo(counter + 1)
arrayone(counter) = arrayone(counter + 1)
arraytwo(counter + 1) = Temp
arrayone(counter + 1) = Temp2
End If
End If
Next
If listcount > -1 Then
listcount = listcount - 1
End If
Loop
'now we need to output arrays to the richtextbox first we will build a new string
'and we can save it to a new sorted file
Dim FILE_NAME As String = "D:\sorted.txt"
'Location of file^ that the new data will be saved to
If System.IO.File.Exists(FILE_NAME) = True Then
Dim objWriter As New System.IO.StreamWriter(FILE_NAME, True)
'If D:\sorted.txt exists then enable it to be written to
While builder < listcount
bigString2 = bigString2 & arraytwo(builder) & "," & arrayone(builder) + Environment.NewLine
objWriter.Write(arraytwo(builder) & "," & arrayone(builder) + Environment.NewLine)
builder = builder + 1
End While
RichTextBox2.Text = bigString2
objWriter.Close()
MsgBox("Text written to log file")
Else
MsgBox("File Does Not Exist")
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
End Class
I think in this line is the problem
arrayone(one) = currentField
Here it trys to cast the string to a double. You have to use something like this:
arrayone(one) = Double.Parse(currentField)
or to have it a saver way:
Dim dbl As Double
If Double.TryParse(currentField, dbl) Then
arrayone(one) = dbl
Else
arrayone(one) = 0.0
End If