I am making a website and I have a for each loop that is taking 2.5 minutes to run through.
I am wondering if anyone knows how i can speed it up. Both of the if statements inside of the loop have to remain there.
Protected Sub WebDataGrid1_InitializeRow(sender As Object, e As Infragistics.Web.UI.GridControls.RowEventArgs) Handles WebDataGrid1.InitializeRow
Dim SqlString As String = ""
Dim TerrMapTable As New DataTable
Dim Terr As String = ""
Dim RgnMgr As String = ""
Dim Reg As String = ""
Dim TerrMap As String = ""
For Each GridRecord As GridRecord In WebDataGrid1.Rows
Terr = GridRecord.Items.FindItemByKey("ABAN8").Value
RgnMgr = GridRecord.Items.FindItemByKey("RgnMgr").Value
If Terr < 9000 Then
Terr = "T" & Terr
Else
Terr = "TA1" & Right(Terr, 2)
End If
SqlString = "Select distinct Terr, Region from TerrReg WHERE Terr='" & Terr & "'"
TerrMapTable = OleFun.GetMyDataTableString(SqlString, 4)
If TerrMapTable.Rows.Count <> 0 Then
Reg = TerrMapTable(0)(1)
TerrMap = "<b>PIC</b>"
GridRecord.Items.FindItemByKey("TerrMap").Text = TerrMap
Else
End If
Next
End Sub
In the event handler for InitializeRow, which I would expect to be called for a single row, you are looping through all of the rows. As a result, I suspect that you have turned an operation that should be linear into the number of rows (with the event firing once for each row, and you operate only on that row) into an operation that is quadratic in the number of rows (for each row, you loop through each row).
Based on the event name, I don't think you should have the For Each loop at all. It looks like you should be getting the appropriate row from the event arguments and operating on that row only.
This could be better suited for code review but here are my thought.
Use string building to concatenate strings
Don't concatenate sql! Use parameters.
Get all the unique Terr and do one query.
Database queries must be your bottleneck.
Terr seems like a mix of number and string. Try option strict on.
Related
I have a Word Document which creates indexcards for books via series. On every page information about a single book. Sometimes two fields have to be swaped for a specific item. So for my collegue it would save a lot of work if that would be possible with a single click. I have programming experience but not so much Office and no VBA.
Is it possible to do something like below? :
Pseudo code:
dim temp as string
dim temp2 as string
select first textbox on active page
temp = select.Text
select second textbox on active page
temp2 = select.Text
select.Text = temp
select first textbox on active page
select.Text = temp2
Any ideas what functions to look in would be welcome. Especialy if it is possible to select the first and second textbox of a single (active) page.
There is probably a better way to do this, but textboxes in word I find to be a real pain.
Here we set the names of the boxes, how you determine the order I'm unsure, maybe a check using titles, or the anchor point. The ID property is not the index so we can't use that.
Sub Rename()
Dim textbox As Object
Dim iter As Long
iter = 1
For Each textbox In ActiveDocument.Shapes 'I'm not sure how to set names manually
textbox.Name = "TextBox " & iter
iter = iter + 1
Next
End Sub
Assuming you have the boxes named in the order they appear:
Sub TextSwap()
Dim targetbox As Long
Dim val1 As String
Dim val2 As String
targetbox = InputBox("Enter an Integer relating to the position of the textbox")
val1 = ActiveDocument.Shapes("TextBox " & targetbox).TextFrame.TextRange.Text
val2 = ActiveDocument.Shapes("TextBox " & (targetbox + 1)).TextFrame.TextRange.Text
ActiveDocument.Shapes("TextBox " & targetbox).TextFrame.TextRange.Text = val2
ActiveDocument.Shapes("TextBox " & (targetbox + 1)).TextFrame.TextRange.Text = val1
End Sub
You'll need to check the input to make sure you don't get errors. I'm also not convinced the names of the textboxes are reliable, but this should work as long as you aren't doing anything too crazy.
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
How can i check for a character after other text within a listbox?
e.g
Listbox contents:
Key1: V
Key2: F
Key3: S
Key4: H
How do I find what comes after Key1-4:?
Key1-4 will always be the same however what comes after that will be user defined.
I figured out how to save checkboxes as theres only 2 values to choose from, although user defined textboxes is what im struggling with. (I have searched for solutions but none seemed to work for me)
Usage:
Form1_Load
If ListBox1.Items.Contains("Key1: " & UsersKey) Then
TextBox1.Text = UsersKey
End If
Which textbox1.text would then contain V / whatever the user defined.
I did try something that kind of worked:
Form1_Load
Dim UsersKey as string = "V"
If ListBox1.Items.Contains("Key1: " & UsersKey) Then
TextBox1.Text = UsersKey
End If
but i'm not sure how to add additional letters / numbers to "V", then output that specific number/letter to the textbox. (I have special characters blocked)
Reasoning I need this is because I have created a custom save settings which saves on exit and loads with form1 as the built in save settings doesn't have much customization.
e.g Can't choose save path, when filename is changed a new user.config is generated along with old settings lost.
Look at regular expressions for this.
Using the keys from your sample:
Dim keys As String = "VFSH"
Dim exp As New RegEx("Key[1-4]: ([" & keys& "])")
For Each item As String in ListBox1.Items
Dim result = exp.Match(item)
If result.Success Then
TextBox1.Text = result.Groups(1).Value
End If
Next
It's not clear to me how your ListBoxes work. If you might find, for example, "Key 2:" inside ListBox1 that you need to ignore, you will want to change the [1-4] part of the expression to be more specific.
Additionally, if you're just trying to exclude unicode or punctuation, you could also go with ranges:
Dim keys As String = "A-Za-z0-9"
If you are supporting a broader set of characters, there are some you must be careful with: ], \, ^, and - can all have special meanings inside of a regular expression character class.
You have multiple keys, I assume you have multiple textboxes to display the results?
Then something like this would work. Loop thru the total number of keys, inside that you loop thru the alphabet. When you find a match, output to the correct textbox:
Dim UsersKey As String
For i As Integer = 1 To 4
For Each c In "ABCDEFGHIJKLMNOPQRSTUVWXYZ".ToCharArray()
UsersKey = c
If ListBox1.Items.Contains("Key" & i & ": " & UsersKey) Then
Select Case i
Case 1
TextBox1.Text = UsersKey
Case 2
TextBox2.Text = UsersKey
Case 3
TextBox3.Text = UsersKey
Case 4
TextBox4.Text = UsersKey
End Select
Exit For 'match found so exit inner loop
End If
Next
Next
Also, you say your settings are lost when the filename is changed. I assume when the version changes? The Settings has an upgrade method to read from a previous version. If you add an UpgradeSettings boolean option and set it to True and then do this at the start of your app, it will load the settings from a previous version:
If My.Settings.UpgradeSettings = True Then
My.Settings.Upgrade()
My.Settings.Reload()
My.Settings.UpgradeSettings = False
My.Settings.Save()
End If
Updated Answer:
Instead of using a listtbox, read the settings file line by line and output the results to the correct textbox based on the key...something like this:
Dim settingsFile As String = "C:\settings.txt"
If IO.File.Exists(settingsFile) Then
For Each line As String In IO.File.ReadLines(settingsFile)
Dim params() As String = Split(line, ":")
If params.Length = 2 Then
params(0) = params(0).Trim
params(1) = params(1).Trim
Select Case params(0)
Case "Key1"
Textbox1.Text = params(1)
Case "Key2"
Textbox2.Text = params(1)
End Select
End If
Next line
End If
You can associate text box with a key via its Name or Tag property. Lets say you use Name. In this case TextBox2 is associated with key2. TextBox[N] <-> Key[N]
Using this principle the code will look like this [considering that your list item is string]
Sub Test()
If ListBox1.SelectedIndex = -1 Then Return
Dim data[] As String = DirectCast(ListBox1.SelectedItem, string).Split(new char(){":"})
Dim key As String = data(0).Substring(3)
Dim val As String = data(1).Trim()
' you can use one of the known techniques to get control on which your texbox sits.
' I omit this step and assume "Surface1" being a control on which your text boxes sit
DirectCast(
(From ctrl In Surface1.Controls
Where ctrl.Name = "TextBox" & key
Select ctrl).First()), TextBox).Text = val
End Sub
As you can see, using principle I just explained, you have little parsing and what is important, there is no growing Select case if, lets say, you get 20 text boxes. You can add as many text boxes and as many corresponding list items as you wish, the code need not change.
...databox.text (from example code below) contains a large list of combined words(domain names) previously populated in the program. There is 1 per each line. In this example, it initially looks like:
thepeople.com
truehistory.com
workhorse.com
whatever.com
neverchange.com
...
The following code below saves the text inside databox to tlistfiltered.txt and then searches tlistfiltered.txt to retrieve all lines that contain any of the items in the list "arr()", and then populates listview(lv) with the results. This works just fine, but the results look like:
thepeople.com
truehistory.com
neverchange.com
...
but what I need is the "found string" (from arr()list to be Proper case so the result would be:
thePeople.com
trueHistory.com
neverChange.com
Here is the code....
Dim s As String = databox.Text
File.WriteAllText(dloc & "tlistfiltered.txt", s)
databox.Clear()
Dim text2() As String = System.IO.File.ReadAllLines(dloc & "tlistfiltered.txt")
Dim arr() As String = {"people", "history", "change"}
For index1 = 0 To arr.GetUpperBound(0)
Dim YesLines() As String = Array.FindAll(text2, Function(str As String)
Return str.Contains(arr(index1))
End Function).ToArray
databox.Visible = True
For index2 = 0 To YesLines.GetUpperBound(0)
Dim match As String = (YesLines(index2)) & vbCrLf
databox.AppendText(match)
Next
Next
s = databox.Text
File.WriteAllText(dloc & "tlistfilteredfinal.txt", s)
databox.Clear()
domains = (From line In File.ReadAllLines(dloc & "tlistfilteredfinal.txt") Select New ListViewItem(line.Split)).ToArray
lv.Items.Clear()
My.Computer.FileSystem.DeleteFile(dloc & "tlistfiltered.txt")
My.Computer.FileSystem.DeleteFile(dloc & "tlistfilteredfinal.txt")
BackgroundWorker1.RunWorkerAsync()
End Sub
Is there a way to do this on the fly? I have tried StrConv etc, but it will only convert the entire line to proper case. I only want the "found" word contained within the line to be converted....
edit:
after seeing #soohoonigan 's answer, i edited
databox.Visible = True
For index2 = 0 To YesLines.GetUpperBound(0)
Dim match As String = (YesLines(index2)) & vbCrLf
databox.AppendText(match)
Next
Next
to this:
databox.Visible = True
For index2 = 0 To YesLines.GetUpperBound(0)
Dim match As String = (YesLines(index2)) & vbCrLf
Dim myTI As System.Globalization.TextInfo = New System.Globalization.CultureInfo("en-US", False).TextInfo
If match.Contains(arr(index1)) Then
match = match.Replace(arr(index1), myTI.ToTitleCase(arr(index1)))
'StrConv(match, vbProperCase)
databox.AppendText(match)
End If
Next
and got the desired result!
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim test As String = "thepeople.com"
Dim search As String = "people"
Dim myTI As System.Globalization.TextInfo = New System.Globalization.CultureInfo("en-US", False).TextInfo
If test.Contains(search) Then
test = test.Replace(search, myTI.ToTitleCase(search))
MsgBox(test)
End If
Me.Close()
End Sub
End Class
I'm not sure to understand the need for using files for intermediate steps and deleting them at the end for example.
First step: getting the lines of the input
That can be done by using the Lines property of databox (which I suspect to be a TextBox or RichTextBox ; if it's not the case we can still use a Split on the Text property)
Dim lines = databox.Lines ' or databox.Text.Split({Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
Second step: we want to filter those lines to keep only the ones containing the searched texts
For this there are several way, a simple one would be to use a Linq query to get the job done
Third step: transforming the result of the filter replacing the searched text by it's capitalized form
So we continue the started query and add a projection (or mapping) to do the transformation.
We need to use TextInfo.ToTitleCase for that.
' See soohoonigan answer if you need a different culture than the current one
Dim textInfo = System.Globalization.CultureInfo.CurrentCulture.TextInfo
Dim query = From word in arr
From line in lines
Where line.Contains(word)
Let transformed = line.Replace(word, textInfo.ToTitleCase(word))
select transformed
' We could omit the Let and do the Replace directly in the Select Clause
I've seen plenty of questions here about strings that are equal returning as unequal, but trust me to not get that problem.
I have this function.
Protected Sub ChkValidStockCode()
If Not (Voucher.ValidStockCode = "") Then
Dim validcount As Int32 = 0
Dim validproduct As String = Product.GetProductNameByCode(Voucher.ValidStockCode)
For Each rpi As RepeaterItem In rptCart.Items
Dim ProductID As HyperLink = CType(rpi.FindControl("hlProductID"), HyperLink)
Dim ProductName As HyperLink = CType(rpi.FindControl("hlProductName"), HyperLink)
If (String.Compare(Voucher.ValidStockCode.ToString(), ProductID.ToString())) Then
validcount = validcount + 1
End If
Next
If validcount = 0 Then
txtVoucher.Text = "Sorry, this voucher is only valid when purchasing a " & validproduct
failed = True
Exit Sub
End If
End If
End Sub
It's supposed to compare the two strings and increment a validcount integer if they're equal, and then tell you off if it gets to the end of the repeater without finding any matches.
The variables in this test are LT00004 (Voucher.ValidStockCode) and SP08076 (ProductID.ToString())
I have run the code several times, outputting the different strings as the result and can confirm they are what they should be, but when I try to compare them (and I expect validCount to be 0), they return as a match.
What did I do to screw this up?
You probably want String.Equals() and not String.Compare(). Compare is used to order things and not test for equality. What's happening is String.Compare is returning a non-zero number so the condition is being satisfied. The reason for that is because in VB "0" is False but any non-zero number evaluates to true. There's a whole history behind why that's the case but I digress.