I have a vb.net program that keeps track of people that bought raffle tickets and also keeps track of their phone numbers. When I go to add a new person(via a for loop) it gets the number of tickets they bought and adds that amount of there name and number to an array. But when I click it, it adds one extra of the prevoius name and number I had put in.
I have tried moving the place where the variable assignment takes place.
I tried to null the variable and reassign it.
Button Click
Public Sub BtnAddtckt_Click(sender As Object, e As EventArgs) Handles
BtnAddtckt.Click
Reset()
Dim MNES As String = Nameinput.Text.ToString
Dim NUMES As String = Numinput.Text.ToString
Dim LenPrev = ApplicantsName.Length - 1
Dim LenNext = (LenPrev) + (NumEntries.Value - 1)
ReDim Preserve ApplicantsName(LenNext)
ReDim Preserve ApplicantsNum(LenNext)
For Subs As Integer = LenPrev To LenNext
ApplicantsNum(Subs) = NUMES
ApplicantsName(Subs) = MNES
Next
LbltotalRegistered.Text = (ApplicantsName.Length - 1).ToString
For nme As Integer = 0 To (ApplicantsName.Length - 1)
Form2.LBname.Items.Add(ApplicantsName(nme).ToString)
Next
For nem As Integer = 0 To (ApplicantsNum.Length - 1)
Form2.LBnum.Items.Add(ApplicantsNum(nem).ToString)
Next
End Sub
I expect it to not add an extra person to each aray.
Related
I am trying to create a simple counter that increases when the button is clicked.
What I would like is when the counter is clicked it displays "01", "02" etc.
I can create it already with "1", "2", but I would like to have a leading zero.
I have searched and found I can do this by converting the label to a string, but I cant seem to get the value to count?
If I change "count.text = counter" to "count.text = cot" it will display "01", but wont count. I'm guessing this is due to the fact its only displaying what is currently in the string but not increasing the value?
If I could get any guidance that would be great!
Many thanks!
Dim counter As Integer = 1
Dim cot As String = String.Format("{0:00}", counter)
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
counter = cot + 1
count.Text = counter
End Sub
PadLeft is the key.
Dim number as Integer = 12
Console.WriteLine(number.ToString().PadLeft(2, "0")). ' prints 12
number = 2
Console.WriteLine(number.ToString().PadLeft(2, "0")). ' prints 02
The problem is, that you don't update your formatted number properly. It's only initialized a single time.
To increment the counter, use counter += 1 or counter = counter + 1 first. This will add 1 to the current value of the integer variable. Then modify the text of your Label by calling that formatting code again: count.Text = String.Format("{0:00}", counter).
This should get you started...
it converts the string into an integer. increments the number, converts it back into a string and then checks for a leading 0, if not found it adds it.
I will let you convert it into your button click for practise, as it should help you have a good understanding of the conversion between types :)
Sub string_counter()
Dim string_counter As String
string_counter = "00"
For x = 0 To 10
Debug.Print string_counter
string_counter = Int(string_counter) + 1
string_counter = Str(string_counter)
If Left(Trim(string_counter), 1) <> "0" Then
string_counter = "0" + Trim(string_counter)
End If
Next x
End Sub
I have a Collection Class (or rather a dictionary class, in this case) that is used to store a variable amount of edge objects. When I try to populate the Dictionary that holds all the information via loop, the data is continuously overwritten and I cannot seem to figure out why. The code for the class in question follows:
Option Explicit
Private pEdges As New Scripting.Dictionary
Property Get Count() As Long
Count = pEdges.Count
End Property
Property Get EdgeByName(ByVal iName As Variant) As cEdge
Set EdgeByName = pEdges(iName)
End Property
'Would it be better to pass all of the data to this add sub, and create
'the class objects here, rather than creating a temporary class object and
'just passing it along?
Sub Add(ByVal iEdge As cEdge)
Dim Edge As New cEdge
Set Edge = iEdge
pEdges.Add Edge.Name, Edge
End Sub
Sub Remove(ByVal iName As Variant)
pEdges.Remove (iName)
End Sub
Sub RemoveAll()
pEdges.RemoveAll
End Sub
Sub PrintNames()
Dim Key As Variant
For Each Key In pEdges
Debug.Print Key & " - " & pEdges(Key).Name & vbCrLf;
Next
Debug.Print vbdrlf;
End Sub
Sub that generates the Edges object follows:
Sub CalculateEdges(cCavities() As cCavity, dEdges As cEdges)
Dim i As Integer
For i = 1 To UBound(cCavities)
Dim TempEdge As cEdge
Set TempEdge = New cEdge
Dim AdjSize As Integer
AdjSize = cCavities(i).AdjacencySize
If AdjSize> MaxEdges Then MaxEdges = AdjSize
Dim j As Integer
For j = 1 To AdjSize
With TempEdge
'Edge Names are a combination of two node names
.Name = cCavities(i).Name & cCavities(i).Adjacency(j)
'Sets the start node (Object) for the edge
.SetNode cCavities(i), 0
'Sets the end node (Object) for the edge
.SetNode BackGround.NodeByName(cCavities, cCavities(i).Adjacency(j)), 1
'Used later in program
.Value = 0
End With
dEdges.Add TempEdge
dEdges.PrintNames
Next j
Next i
End Sub
The output of the dEdges.PrintNames sub is what I have been using for debugging this (since the Watches window doesn't show the item data of a dictionary).
As the loops go on it prints the Key and the Name Value of the edge object that the key corresponds to. If working correctly, these two strings should be identical. As it is though, every time I add a new edge object to the dictionary, it overwrites the objects for all the previously entered keys. I have the suspicion that this is related to the fact that I create a TempEdge Variable to pass to the Collection Class, but I am not sure.
Example of output:
C1C2 - C1C2
C1C2 - C1C3
C1C3 - C1C3
C1C2 - C1C4
C1C3 - C1C4
C1C4 - C1C4
ETC
This is just one single data point being tested, but let me assure you that all the variables inside the cEdge object are overwritten, not just the name string. It is simply the easiest to check since it is just a string.
As a side note, if there is a way to see the Object stored in the dictionary, similar to the "Watches" window, I would very much like to know how to do it. The entire reason I am even using the temp edge at this point is so I can keep track of what data is going into the dictionary at any given point in the loop.
Second side note, If I can get this working I will most likely switch the cCavities array to a similar collection class. It is not currently one because I cant seem to get them working right.
Moving the Set "TempEdge = New cEdge" into the loop will create a new instance and a new pointer location with every loop while maintaining your collections references to previous pointers.
Sub CalculateEdges(cCavities() As cCavity, dEdges As cEdges)
Dim i As Integer
For i = 1 To UBound(cCavities)
Dim TempEdge As cEdge
Dim AdjSize As Integer
AdjSize = cCavities(i).AdjacencySize
If AdjSize> MaxEdges Then MaxEdges = AdjSize
Dim j As Integer
For j = 1 To AdjSize
Set TempEdge = New cEdge
With TempEdge
'Edge Names are a combination of two node names
.Name = cCavities(i).Name & cCavities(i).Adjacency(j)
'Sets the start node (Object) for the edge
.SetNode cCavities(i), 0
'Sets the end node (Object) for the edge
.SetNode BackGround.NodeByName(cCavities, cCavities(i).Adjacency(j)), 1
'Used later in program
.Value = 0
End With
dEdges.Add TempEdge
dEdges.PrintNames
Next j
Next i
End Sub
I went ahead with the idea to pass along all the data to the add routine, and it seems to have solved the issue. I would still like to know why the method I was using did not work, though, so please feel free to comment or answer with regards to that.
The solution was to change the cEdges.Add Sub to accept all the individual parameters that were once passed to the temporary edge variable:
Sub Add(ByVal iName As String, iNode1 As cCavity, iNode2 As cCavity, iValue As Integer)
Dim Edge As New cEdge
With Edge
.Name = iName
.SetNode iNode1, 0
.SetNode iNode2, 1
.Value = iValue
End With
pEdges.Add Edge.Name, Edge
End Sub
This changes the populating loop to look like:
Sub CalculateEdges(cCavities() As cCavity, dEdges As cEdges)
Dim i As Integer
For i = 1 To UBound(cCavities)
Dim AdjSize As Integer
AdjSize = cCavities(i).AdjacencySize
If AdjSize > MaxEdges Then MaxEdges = AdjSize
Dim j As Integer
For j = 1 To AdjSize
dEdges.Add cCavities(i).Name & cCavities(i).Adjacency(j), cCavities(i), BackGround.NodeByName(cCavities, cCavities(i).Adjacency(j)), 0
dEdges.PrintNames
Next j
Next i
End Sub
This code, especially the .Add line, could be cleaned up. I will most likely do that, but this is fine for now.
EDIT: Upon further research and a bit more trial and error, I have discovered the reason for the data being overwritten. The Set keyword only creates a pointer to the original value, effectively making my above code have one object, the TempEdge variable, and a whole bunch of different heads that pointed to it. That is why when the Temp edge was edited, all the subsequent heads changes.
I have a Part class with the fields list in the code below. I have a DataGridView control, which I am filtering with the Advanced DGV (ADGV) DLL from NUGET. I must include the ADGV in my winform. I currently have a DataGridView, a search box on the form, and a button to run the following function. I need to go through all of the visible rows, collect a unique list of part numbers with their most recent revisions, and then color the rows in DataGridView which are out of date by checking the part number and rev on each row against the mostuptodate list. For 45,000 entries displayed in DataGridView, this take ~17 secs. For ~50 entries, it take ~1.2 seconds. This is extremely inefficient, but I can't see a way to cut the time down.
Sub highlightOutdatedParts()
'Purpose: use the results in the datagridview control, find the most recent revision of each part, and
' highlight all outdated parts relative to their respective most recent revisions
'SORT BY PART NUMBER AND THEN BY REV
If resultsGrid.ColumnCount = 0 Or resultsGrid.RowCount = 0 Then Exit Sub
Dim stopwatch As New Stopwatch
stopwatch.Start()
resultsGrid.Sort(resultsGrid.Columns("PartNumber"), ListSortDirection.Ascending)
Dim iBag As New ConcurrentBag(Of Part)
Dim sortedList As Generic.List(Of Part)
For Each row As DataGridViewRow In resultsGrid.Rows
If row.Visible = True Then
Dim iPart As New Part()
Try
iPart.Row = row.Cells(0).Value
iPart.Workbook = CStr(row.Cells(1).Value)
iPart.Worksheet = CStr(row.Cells(2).Value)
iPart.Product = CStr(row.Cells(3).Value)
iPart.PartNumber = CStr(row.Cells(4).Value)
iPart.ItemNo = CStr(row.Cells(5).Value)
iPart.Rev = CStr(row.Cells(6).Value)
iPart.Description = CStr(row.Cells(7).Value)
iPart.Units = CStr(row.Cells(8).Value)
iPart.Type = CStr(row.Cells(9).Value)
iPart.PurchCtgy = CStr(row.Cells(10).Value)
iPart.Qty = CDbl(row.Cells(11).Value)
iPart.TtlPerProd = CDbl(row.Cells(12).Value)
iPart.Hierarchy = CStr(row.Cells(13).Value)
iBag.Add(iPart)
Catch ice As InvalidCastException
Catch nre As NullReferenceException
End Try
End If
Next
sortedList = (From c In iBag Order By c.PartNumber, c.Rev).ToList() ' sort and convert to list
Dim mostUTDRevList As New Generic.List(Of Part) ' list of most up to date parts, by Rev letter
For sl As Integer = sortedList.Count - 1 To 0 Step -1 'start at end of list and work to beginning
Dim query = From entry In mostUTDRevList ' check if part number already exists in most up to date list
Where entry.PartNumber = sortedList(sl).PartNumber
Select entry
If query.Count = 0 Then ' if this part does not already exist in the list, add.
mostUTDRevList.Add(sortedList(sl))
End If
Next
'HIGHLIGHT DATAGRIDVIEW ROWS WHERE PART NUMBERS ARE OUT OF DATE
For Each row As DataGridViewRow In resultsGrid.Rows
' if that part with that Rev does not exist in the list, it must be out of date
Try
Dim rowPN As String = CStr(row.Cells(4).Value).ToUpper ' get part number
Dim rowR As String = CStr(row.Cells(6).Value).ToUpper ' get Rev
Dim query = From entry In mostUTDRevList ' check if that part number with that Rev is in the list.
Where entry.PartNumber.ToUpper.Equals(rowPN) AndAlso
entry.Rev.ToUpper.Equals(rowR)
Select entry
If query.Count = 0 Then ' if the part is out of date highlight its' row
row.DefaultCellStyle.BackColor = Color.Chocolate
End If
Catch ex As NullReferenceException
Catch ice As InvalidCastException
End Try
Next
resultsGrid.Select()
stopwatch.Stop()
If Not BackgroundWorker1.IsBusy() Then timertextbox.Text = stopwatch.Elapsed.TotalSeconds.ToString & " secs"
MessageBox.Show("Highlighting completed successfully.")
End Sub
It is almost always faster to work with the data than the control. The control is simply the means to present a view of the data (in a grid) to the users. Working with the data from there requires too much converting to be effieicent. Then, use the DGV events to highlight the rows
Its hard to tell all the details of what you are doing, but it looks like you are comparing the data to itself (as opposed to some concrete table where the lastest revision codes are defined). Nor is it clear why the datasources are collections, ConcurrentBags etc. The key would be to use collections optimized for the job.
To demonstrate, I have a table with 75,000 rows; the product codes are randomly selected from a pool of 25,000 and a revision code is a random integer (1-9). After the DGV datasource is built (a DataTable) a LookUp is created from the ProductCode-Revision pair. This is done once and once only:
' form level declaration
Private PRCodes As ILookup(Of String, Int32)
' go thru table
' group by the product code
' create an anon Name-Value object for each,
' storing the code and highest rev number
' convert result to a LookUp
PRCodes = dtSample.AsEnumerable.
GroupBy(Function(g) g.Item("ProductCode"),
Function(key, values) New With {.Name = key.ToString(), .Value = values.
Max(Of Int32)(Function(j) j.Field(Of Int32)("RevCode"))
}).
ToLookup(Of String, Int32)(Function(k) k.Name, Function(v) v.Value)
Elapsed time via stopwatch: 81 milliseconds to create the collection of 23731 items. The code uses an anonymous type to store a Max Revision code for each product code. A concrete class could also be used. If you're worried about mixed casing, use .ToLowerInvariant() when creating the LookUp (not ToUpper -- see What's Wrong With Turkey?) and again later when looking up the max rev.
Then rather than looping thru the DGV rows use the RowPrePaint event:
If e.RowIndex = -1 Then Return
If dgv1.Rows(e.RowIndex).IsNewRow Then Return
' .ToLowerInvariant() if the casing can vary row to row
Dim pc = dgv1.Rows(e.RowIndex).Cells("ProductCode").Value.ToString()
Dim rv = Convert.ToInt32(dgv1.Rows(e.RowIndex).Cells("RevCode").Value)
Dim item = PRCodes(pc)(0)
If item > rv Then
dgv1.Rows(e.RowIndex).DefaultCellStyle.BackColor = Color.MistyRose
End If
Notes
It takes some time to create the DataSource, but 75,000 rows is a lot to throw at a user
The time to create the LookUp is minimal - barely measurable
There is no noticeable wait in displaying them because a) the LookUp is made for this sort of thing, b) rows are done as needed when they are displayed. Row # 19,999 may never be processed if the user never scrolls that far.
This is all geared to just color a row. If you needed to save the Current/NotCurrent state for each row, add a Boolean column to the DataTable and loop on that. The column can be invisible if to hide it from the user.
The random data results in 47,000 out of date RevCodes. Processing 75k rows in the DataTable to set the flag takes 591 milliseconds. You would want to do this before you set the DataTable as the DataSource to prevent changes to the data resulting in various events in the control.
In general, the time to harvest the max RevCode flag and even tag the out of date rows is a trivial increment to creating the datasource.
The Result:
The data view is sorted by ProductCode so that the coloring of lower RevCodes is apparent.
We surely cant grok all the details and constraints of the system from a small snippet - even the data types and original datasource are a guess for us. However, this should provide some help with better look-up methods, and the concept of working with the data rather than the user's view.
One thing is the revision code - yours is treating them as a string. If this is alphanumeric, it may well not compare correctly - "9" sorts/compares higher than "834" or "1JW".
See also:
Lookup(Of TKey, TElement) Class
Anonymous Types
The solution was spurred in part by #Plutonix.
Sub highlightOutdatedParts()
If resultsGrid.ColumnCount = 0 Or resultsGrid.RowCount = 0 Then Exit Sub
Dim stopwatch As New Stopwatch
stopwatch.Start()
resultsGrid.DataSource.DefaultView.Sort = "PartNumber ASC, Rev DESC"
resultsGrid.Update()
'HIGHLIGHT DATAGRIDVIEW ROWS WHERE PART NUMBERS ARE OUT OF DATE
Dim irow As Long = 0
Do While irow <= resultsGrid.RowCount - 2
' if that part with that Rev does not exist in the list, it must be out of date
Dim utdPN As String = resultsGrid.Rows(irow).Cells(4).Value.ToString().ToUpper()
Dim utdRev As String = resultsGrid.Rows(irow).Cells(6).Value.ToString().ToUpper()
Dim iirow As Long = irow + 1
'If iirow > resultsGrid.RowCount - 1 Then Exit Do
Dim activePN As String = Nothing
Dim activeRev As String = Nothing
Try
activePN = resultsGrid.Rows(iirow).Cells(4).Value.ToString().ToUpper()
activeRev = resultsGrid.Rows(iirow).Cells(6).Value.ToString().ToUpper()
Catch ex As NullReferenceException
End Try
Do While activePN = utdPN
If iirow > resultsGrid.RowCount - 1 Then Exit Do
If activeRev <> utdRev Then
resultsGrid.Rows(iirow).DefaultCellStyle.BackColor = Color.Chocolate
End If
iirow += 1
Try
activePN = resultsGrid.Rows(iirow).Cells(4).Value.ToString().ToUpper()
activeRev = resultsGrid.Rows(iirow).Cells(6).Value.ToString().ToUpper()
Catch nre As NullReferenceException
Catch aoore As ArgumentOutOfRangeException
End Try
Loop
irow = iirow
Loop
resultsGrid.Select()
stopwatch.Stop()
If Not BackgroundWorker1.IsBusy() Then
timertextbox.Text = stopwatch.Elapsed.TotalSeconds.ToString & " secs"
resultcounttextbox.Text = resultsGrid.RowCount - 1 & " results"
End If
MessageBox.Show("Highlighting completed successfully.")
End Sub
I am attempting to pass the selected values from a list box in Excel to legend in a chart. Specifically, I have data of certain companies in the following format
And I also have a list box, globalList, which contains the names of companies that can be selected. Selected companies' data will then be passed onto a chart using VBA.
However, the problems I encounter are in the following sections:
Initialising a variable to hold values selected in the globalList
listMax = globalList.ListCount - 1
`this creates the upper bound for the list box
For i = 0 To (globalList.ListCount - 1)
If globalList.Selected(i) = True Then
companiesSelected = companiesSelected + 1
End If
If i = listMax Then
Exit For
End If
Next i
`the above is used to retrieve the number of companies that have been selected by a user - whether =0 or > 0
Dim myLegend() As String
ReDim myLegend(0 To (globalList.ListCount - 1))
For i = 0 To (globalList.ListCount - 1)
If globalList.Selected(i) = True Then
myLegend(i) = globalList.List(i)
End If
If i = listMax Then
Exit For
End If
Next i
`this is the array object in which I intend to store company names selected in the list box.
The problem is that even though the above creates the myLegend string array, it also contains empty array items for the companies that may not have been selected by the user in the list box.
And even if I am able to remove these empty items from the array, the following problem occurs
Passing the held values from my variable to my chart
For i = 1 To companiesSelected
myChart.SeriesCollection(i).Name = myLegend(i)
Next i
Problem here is that myLegend array starts from 0, while SeriesCollection seems to start from 1. So I am unable to pass the string values for selected items to the legend of my chart's.
Could somebody please point out how to circumvent these problems?
Many thanks in advance!
Here is a code to extract the selected items into an one-based array of String (without empty items):
Dim i As Integer
Dim iCount As Integer
Dim myLegend() As String
iCount = 0
With globalList
ReDim myLegend(1 To .ListCount)
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
iCount = iCount + 1
myLegend(iCount) = .List(i)
End If
Next i
End With
If iCount > 0 Then
ReDim Preserve myLegend(1 To iCount)
Else
ReDim myLegend(1 To 1)
myLegend(1) = "Nothing here!"
End If
I'm trying to filter a list based on input from a textbox. If the item doesn't contain the string, it is deleted from the list. Here is my subroutine:
Sub filterlists(filter As String)
Dim removalDifferential As Integer = 0
For colE As Integer = 0 To RadListView1.Items.Count
Try
Dim itemEpp As ListViewDataItem = Me.RadListView1.Items(colE)
Dim jobname As String = itemEpp(0)
If Not jobname.Contains(filter) Then
' MsgBox(jobname & " Contains " & filter)
RadListView1.Items.RemoveAt(colE - removalDifferential)
removalDifferential = removalDifferential + 1
End If
Catch
End Try
Next
End Sub
Currently this is not deleting the correct items. The TRY is there because when you delete an item the list index changes (which means the for loop length is wrong and will throw outofbounce errors). Any other loop options that will work here?
Assuming you really do want to delete any LVI which simply contains the filter text, you should loop backwards thru the items (any items, not just Listview items) so the index variable will in fact point to the next correct item after a deletion:
For n As Integer = RadListView1.Items.Count-1 to 0 Step -1
If radListView1.Items(n).Text.Contains(filter) Then
RadListView1.Items.RemoveAt(n)
End If
Next