My Goal is to take two rows(FirstName and Surname) Convert them to a single Array of "FirstName, Surname".
This is my terrible code i eventually put together
Private Sub Search_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'DbaPatientDataSet.tblPatientData' table. You can move, or remove it, as needed.
Me.TblPatientDataTableAdapter.Fill(Me.DbaPatientDataSet.tblPatientData)
listFirst.DataSource = Me.TblPatientDataBindingSource
listFirst.DisplayMember = "FirstName"
listLast.DataSource = Me.TblPatientDataBindingSource
listLast.DisplayMember = "Surname"
Dim Lenth As Integer = Me.listFirst.Items.Count - 1
Dim count As Integer = 1
Dim ArrFirst(Lenth) As String
Dim ArrLast(Lenth) As String
For count = 1 To Lenth
ArrFirst(count) = listFirst.Items(count).ToString
ArrLast(count) = listLast.Items(count).ToString
Next count
count = 1
For count = 1 To Lenth
arrFullName(count) = ArrLast(count) & ", " & ArrFirst(count)
Next count
'Arrays Set =====================================================
But with this code i get an Array of
`"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
`
As you can see
Here
There must be an easy way to convert both DataRows to strings then concatenate them together in an array
I am going to search this array using a Binary Search to find a desired name
Thanks
First, I think you are confusing your rows and your columns. You have 2 columns. I went directly to full name but I think you can break it out if you need to.
Dim arrNames(ListBox1.Items.Count - 1) As String
For i As Integer = 0 To ListBox1.Items.Count - 1
arrNames(i) = $"{ListBox1.Items(i)} {ListBox2.Items(i)}"
Next
For Each item In arrNames
Debug.Print(item)
Next
The string with the $ in front is an interpolated string. Sort of an improvement to String.Format.
I know there is an answer but for now you could go direct to the data table to get what you need.
Dim arrNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
Dim dt As DataTable = DbaPatientDataSet.Tables(0)
For Each row As DataRow In dt.Rows
arrNames(i) = $"{row("Surname")}, {row("FirstName")}"
i += 1
Next
For Each item In arrNames
Debug.Print(item)
Next
'assume the names of your columns are Surname and FirstName
If I run your code up, I get the result you are looking for, so I'm not sure what you are missing. In saying that though, you are making things hard on yourself by messing around with arrays :). Just use the dataset rows directly - they are strongly typed and you can check for nulls etc as needed... something like this;
Dim fullNames As New List(Of String) '-- or you could fill your array.
For Each row As DbaPatientDataSet.tblPatientDataRow In ds.tblPatientData
fullNames.Add(row.Surname & ", " & row.FirstName)
Next
Just looking at what you are trying to achieve, if it was me, I would be bringing back the formatted data in my query that fills the dataset i.e. a third, FullName, column.
It has been in the back of my mind. Finally got it for the List Box directly.
Dim arrFullNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
For Each item As DataRowView In ListBox1.Items
arrFullNames(i) = $"{DirectCast(item("Surname"), String)}, {DirectCast(item("Firstname"), String)}"
i += 1
Next
For Each item As String In arrFullNames
Debug.Print(item)
Next
Related
I have two arrays: TempSubject(), which carries a list of subjects, and friRoutine(), which indicates when subjects are taught.
I need to enforce a rule that no particular subject can not be taught twice on a specific day. I have a function named DetectDuplicate(friRoutine, Tempsubject(i)), which checks friRoutine() with TempSubject() and finds whether friRoutine already contains a particular subject. If No, then add that unique subject to friRoutine. Otherwise continue through the loop for next subject. My code is furnished below as follows-
Dim TempSubject() As String = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
dim c4 as integer = 0
dim limitcounter = 0
dim friRoutine() as string
reedim friRoutine(6)
While c4 < TempSubject.Length
If DetectDuplicate(friRoutine, TempSubject(c4)) = False And limitcounter4 < 7 Then
friRoutine(limitcounter4) = TempSubject(c4)
'MessageBox.Show(c1 & ": " & limitcounter1 & ": " & tueRoutine(limitcounter1))
Debug.WriteLine("Friday: " & c4 & ": " & limitcounter4 & ": " & friRoutine(limitcounter4))
TempSubject.RemoveAt(c4)
limitcounter4 = limitcounter4 + 1
End If
c4 = c4 + 1
End While
Private Function DetectDuplicate(ByVal arr As Array, ByVal str As String) As Boolean
Dim numcount As Integer = 0
For numcount = 0 To arr.Length - 1
If arr(numcount) = str Then
Return True
End If
Next
Return False
End Function
The Output is supposed to be
friRoutine = Math, english, sanskrit, Urdu, French, Physical education, game
but unfortunately, English is missing.
the output is:
friRoutine = Math, sanskrit, Urdu, French, Physical education, game, science
I'm afraid of using my code as it may spoil the entire process at any point of time.
I think the problem is with Function DetectDuplicate()
Edit (From a comment)
I have to remove the used elements. My original program will have 42 subjects and 6 days. 7 periods everyday. For example if i picked up 7 unique subjects for Monday then for the next 6 days i must have only 35 subjects to be adjusted for rest of the 5 days.
The first thing I would do is convert the arrays to generic Lists. So this:
Dim TempSubject() As String = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine() As String
Becomes this:
Dim TempSubject As New List(Of String) From {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine As New List(Of String)(6)
You can access items in these lists by index, just like with arrays, but now it becomes MUCH easier to do things like add or remove entries. At least, I would do this for the friRoutine collection; there is some argument to made for an array in way TempSubject is used in this code, but even there the data likely came form somewhere that would justify a List(Of String) instead.
That done, you can greatly simplify the code:
friRoutine.AddRange(TempSubject)
friRoutine = friRoutine.Distinct().Take(7).ToList()
Or, to show the entire sample:
Dim TempSubject = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine As New List(Of String)(TempSubject.Distinct().Take(7))
For i As Integer = 0 to friRoutine.Count - 1
Debug.WriteLine($"Friday: {i} : {friRoutine(i)}")
Next
And now that we see the data for friRoutine can be computed from a single line of code, one wonders if we really need the separate collection at all.
As for the original code, the big problem was this line:
TempSubject.RemoveAt(c4)
This modified the collection while still looping through it. Everything would shift forward, causing some items to be skipped.
Just use Enumerable.Distinct<T>()
Dim TempSubject = {"Maths","English","Sanskrit","Sanskrit","Urdu","Urdu","Urdu","French","French","French","Physical Education","Physical Education","Game","Game", "Science"}
Dim friRoutine = TempSubject.Distinct().ToArray()
If you want a List output instead, then it's simply
Dim friRoutine = TempSubject.Distinct().ToList()
Since both array and List are Enumerable, TempSubject can be either an array or List.
I'm an extreme beginner with vb and coding in general and this is my first post on this site. I am running into a wall with a project I am working on. This is the smallest block of code in the project but all other functions will pull from the array I'm trying to populate. Essentially I need to populate an array with numbers representing the prices of DVDs from a .txt file. The .txt file is formatted as follows:
The Lord of the Rings, 10.50
Avatar, 5
Gangs of New York, 7.5
etc
Where 10.50 is the value I would want to assign to dblPrices(0). It is required to not change the format of the .txt file. So far, this is what I was using but when testing the output I'm getting back 0's:
'Declare variables.
Dim intCount As Integer = 0
Dim strLine As String
'Open the file for input.
inFile = IO.File.OpenText("availableDVDs.txt")
'Remove alpha characters from string, assign numeric values to array representing price.
Do Until inFile.Peek = -1
strLine = inFile.ReadLine.ToUpper.Replace("[A-Z]", "")
strLine = strLine.Replace(" ", "")
strLine = strLine.Replace(",", "")
Double.TryParse(strLine, dblPrices(intCount))
intCount += 1
Loop
This is related to a school project so I'm not necessarily looking for someone to do my work for me, but perhaps point me in the right direction. Thank you!
If you use List(Of T) (The T stands for Type, like Integer or String or your own type) then you don't need to know the size in advance like an array. Also you don't need to keep track of indexes. You can just use the .Add method and the new item is put at the end of the list.
You can get a head start on getting the data out of the file by using File.ReadAllLines which will return an array of lines in the text file. Then you can just .Split each line on the "," (comma) and use the second element of the resulting array. The little c after the comma in double quotes tells the compiler that you mean this a Char which is the datatype that .Split is expecting.
I used a Decimal datatype instead of Double. When working with money it is safer to use to get the answer you expect.
In the second code sample I used an Interpolated sting indicated by the $ preceding the string. Notice that it is very similar to String.Format only the variable is inserted directly in the braces instead of a placeholder. This is available in Visual Studio 2015 and later.
The array method...
Private Sub OPCode()
Dim Lines = IO.File.ReadAllLines("availableDVDs.txt")
Dim Prices(Lines.Count - 1) As Decimal
Dim index As Integer
Dim price As Decimal
For Each line In Lines
Dim SplitOnComma = line.Split(","c)
If Decimal.TryParse(SplitOnComma(1), price) Then
Prices(index) = price
index += 1
Else
MessageBox.Show(String.Format("Price for {0} is not valid.", SplitOnComma(0)))
End If
Next
End Sub
The list method...
Private Sub UsingList()
Dim Lines = IO.File.ReadAllLines("availableDVDs.txt")
Dim Prices As New List(Of Decimal)
Dim price As Decimal
For Each line In Lines
Dim SplitOnComma = line.Split(","c)
If Decimal.TryParse(SplitOnComma(1), price) Then
Prices.Add(price)
Else
MessageBox.Show($"Price for {SplitOnComma(0)} is not valid.")
End If
Next
End Sub
With Option Infer Off
Private Sub OPCode()
Dim Lines() As String = IO.File.ReadAllLines("availableDVDs.txt")
Dim Prices(Lines.Count - 1) As Decimal
Dim index As Integer
Dim price As Decimal
For Each line In Lines
Dim SplitOnComma() As String = line.Split(","c)
If Decimal.TryParse(SplitOnComma(1), price) Then
Prices(index) = price
index += 1
Else
MessageBox.Show(String.Format("Price for {0} is not valid.", SplitOnComma(0)))
End If
Next
End Sub
The aim of my application is to extract text from documents and search for specific entries matching records in a database.
My application extracts text from documents and populates a textbox
with the extracted text.
Each document can have anywhere from 200 to 600,000 words
(including a large amount of normal plain text).
Extracted text is compared against database entries for specific
values and matches are pushed into an array.
My Database contains approximately 125,000 records
My code below loops through the database records, comparing against the extracted text. If a match is found in the text it is inserted into an array which I use later.
txtBoxExtraction.Text = "A whole load of text goes in here, " & _
"including the database entries I am trying to match," & _
"i.e. AX55F8000AFXZ and PP-Q4681TX/AA up to 600,000 words"
Dim dv As New DataView(_DBASE_ConnectionDataSet.Tables(0))
dv.Sort = "UNIQUEID"
'There are 125,000 entries here in my sorted DataView dv e.g.
'AX40EH5300
'GB46ES6500
'PP-Q4681TX/AA
For i = 0 to maxFileCount
Dim path As String = Filename(i)
Try
If File.Exists(path) Then
Try
Using sr As New StreamReader(path)
txtBoxExtraction.Text = sr.ReadToEnd()
End using
Catch e As Exception
Console.WriteLine("The process failed: {0}", e.ToString())
End Try
end if
For dvRow As Integer = 0 To dv.Table.Rows.Count - 1
strUniqueID = dv.Table.Rows(dvRow)("UNIQUEID").ToString()
If txtBoxExtraction.Text.ToLower().Contains(strUniqueID.ToLower) Then
' Add UniqueID to array and do some other stuff..
End if
next dvRow
next i
Whilst the code works, I am looking for a faster way of performing the database matching (the 'For dvRow' Loop).
If a document is small with around 200 words, the 'For dvRow..' Loop completes quickly, within a few seconds.
Where the document contains a large amount of text... 600,000 words and upwards, it can take several hours or longer to complete.
I came across a couple of posts that are similar, but not close enough to my issue to implement any of the recommendations.
High performance "contains" search in list of strings in C#
https://softwareengineering.stackexchange.com/questions/118759/how-to-quickly-search-through-a-very-large-list-of-strings-records-on-a-databa
Any help is most gratefully appreciated.
This is an example of the comment a wrote.
If that's the actual code, I don't understand why you need to put the
information in a textbox. You could save a bit of speed by not
displaying the text on screen. If you have 125000 UNIQUEIDs, then it
might be better to pull the id from your file and then search from
that list. Instead of searching the whole text every time. Even just
splitting your text by space and filtering by the "words" that are
between a specific size could make it go faster.
Since it seems you want to do a word check and not a per-character check. And that you only want to check for those ids and not each word. You should pull up the ids from each text before doing any search. This will reduce the searching that need to be done by a lot. This list of id could also be saved if the text never changes.
Module Module1
Private UNIQUEID_MIN_SIZE As Integer = 8
Private UNIQUEID_MAX_SIZE As Integer = 12
Sub Main()
Dim text As String
Dim startTime As DateTime
Dim uniqueIds As List(Of String)
text = GetText()
uniqueIds = GetUniqueIds()
'--- Very slow
startTime = DateTime.Now
' Search
For Each uniqueId As String In uniqueIds
text.Contains(uniqueId)
Next
Console.WriteLine("Took {0}s", DateTime.Now.Subtract(startTime).TotalSeconds)
'--- Very fast
startTime = DateTime.Now
' Split the text by words
Dim words As List(Of String) = text.Split(" ").ToList()
' Get all the unique key, assuming keys are between a specific size
Dim uniqueIdInText As New Dictionary(Of String, String)
For Each word As String In words
If word.Length < UNIQUEID_MIN_SIZE Or word.Length > UNIQUEID_MAX_SIZE Then
If Not uniqueIdInText.ContainsKey(word) Then
uniqueIdInText.Add(word, "")
End If
End If
Next
' Search
For Each uniqueId As String In uniqueIds
uniqueIdInText.ContainsKey(uniqueId)
Next
Console.WriteLine("Took {0}s", DateTime.Now.Subtract(startTime).TotalSeconds)
Console.ReadLine()
End Sub
' This only randomly generate words for testing
' You can ignore
Function GetRandomWord(ByVal len As Integer) As String
Dim builder As New System.Text.StringBuilder
Dim alphabet As String = "abcdefghijklmnopqrstuvwxyz"
Dim rnd As New Random()
For i As Integer = 0 To len - 1
builder.Append(alphabet.Substring(rnd.Next(0, alphabet.Length - 1), 1))
Next
Return builder.ToString()
End Function
Function GetText() As String
Dim builder As New System.Text.StringBuilder
Dim rnd As New Random()
For i As Integer = 0 To 600000
builder.Append(GetRandomWord(rnd.Next(1, 15)))
builder.Append(" ")
Next
Return builder.ToString()
End Function
Function GetUniqueIds() As List(Of String)
Dim wordCount As Integer = 600000
Dim ids As New List(Of String)
Dim rnd As New Random()
For i As Integer = 0 To 125000
ids.Add(GetRandomWord(rnd.Next(UNIQUEID_MIN_SIZE, UNIQUEID_MAX_SIZE)))
Next
Return ids
End Function
End Module
Here in my code, i have a database which has table of my applicants. As you will see in the code below, i want to get the number of rows from my command text and transfer it to the string "abc"
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
myr.Close()
mycom.Connection = cn
mycom.CommandText = "SELECT Count(Cellphone) FROM tbl_applicant where Gender='Female';"
myr = mycom.ExecuteReader
Dim abc As String
If myr.Read Then
abc = myr(0)
End If
myr.Close()
On the code Below i used the abc as the number of data i must acquire. Then i used the new query to get the values i wanted to and transfer them to a String Array, as you can see I Redim the universal variable Numb to abc to have its array boundery.
mycom.CommandText = "SELECT Cellphone FROM tbl_applicant where Gender='Female';"
myr = mycom.ExecuteReader
ReDim Numb(abc)
If myr.Read Then
For i As Integer = 1 To abc.ToString - 1
LOT = myr(0).ToString
LOT = LOT + (myr(i).ToString + ",") <- this is where i get the error it says that index is our of range.
Numb = LOT.Split(",")
Next
End If
In this code below, i want the values of Variable Numb() to be transferred to a multiline textbox
Dim sbText As New System.Text.StringBuilder(500)
For i As Integer = 0 To Numb.Length - 2
' This will convert the number to a string, add it to the stringbuilder
' and then append a newline to the text buffer
sbText.AppendLine(Numb(i))
Next i
' Now move the buffer into the control
TextBox1.Text = sbText.ToString()
End Sub
The end value i must see in the textbox should be like
11111111111
11111111112
11111111113
11111111114
and so forth, please try to understand the numbers i am referring it to real phone numbers. Any help with the problem or solution maybe.. Thanks
I don't think you need to first query the db to get the count of records before then going back to the db to get the phonenumbers, you could just do this:
mycom.CommandText = "SELECT Cellphone FROM tbl_applicant where Gender='Female';"
myr = mycom.ExecuteReader
While myr.Read()
TextBox1.Text = TextBox1.Text & myr(0) & Environment.NewLine
End While
No need for array's or List's
While this is just a rough guide and an attempt at understanding your issue, try the code and see if it works for you.
I have a spreadsheet of data that I want to put into a VBA array which then outputs unique values to a new sheet. I have got that to work so far. However, some of the cells in the original data have text separated by commas, and I want to add those to the array as well. I can't quite get that bit to work.
After the various 'dims', my code is
'Grabs the data to work with
Set rTable = Worksheets("Data Entry").Range("N1:N100", "P1:P100")
'Puts it into an array
MyArray = rTable.Value
'Sets where the data will end up
Set rCell = Worksheets("TestSheet").Range("A1:A100")
'Each unique entry gets added to the new array
On Error Resume Next
For Each a In MyArray
UnqArray.Add a, a
Next
'Add unique data to new location
For i = 1 To UnqArray.Count
rCell(i, 1) = UnqArray(i)
Next
I have tried doing a new variant to store the split data
SpArray = split(MyArray,", ")
and then have that here
MyArray = rTable.Value
SpArray = split(MyArray,", ")
and then refer to SpArray for the rest of the code
I've also tried to have as part of
For Each a in SpArray
but it doesn't work for me.
Do I need to do a separate loop on each cell of the array before I filter out the unique ones?
Yes, you need another loop. But if you set a reference to Microsoft Scripting Runtime and use a Dictionary object, you can eliminate the loop that writes to the range because Dictionary.Keys returns an array.
In this example, it attempts to split every entry on a comma and treats each of those as a unique. If there is no comma, Split returns the one value so it works in both cases. There's probably a small cost to splitting things that don't need to be split, but you won't notice until your range is much larger. And it makes the code cleaner, I think.
Sub WriteUniques()
Dim dcUnique As Scripting.Dictionary
Dim vaData As Variant
Dim vaSplit As Variant
Dim i As Long, j As Long
vaData = Sheet1.Range("$I$12:$I$62").Value
Set dcUnique = New Scripting.Dictionary
For i = LBound(vaData, 1) To UBound(vaData, 1)
vaSplit = Split(vaData(i, 1), ",")
For j = LBound(vaSplit) To UBound(vaSplit)
If Not dcUnique.Exists(vaSplit(j)) Then
dcUnique.Add vaSplit(j), vaSplit(j)
End If
Next j
Next i
Sheet1.Range("J12").Resize(dcUnique.Count, 1).Value = Application.Transpose(dcUnique.Keys)
End Sub
The code tweak that worked for me was to put the Split at the end.
'Add unique data to new location
For i = 1 To UnqArray.Count
rCell(i, 1) = Split(UnqArray(i), ",")
Next
This then built up an array using data from different ranges and splitting up comma separated ones before outputting only the unique ones.