Checked listview for duplicates - vb.net

Hi Can you please help me to solve this i want to find the duplicates in listview. This is my code
For Up As Integer = lvCart.Items.Count - 1 To 1 Step -1
For down As Integer = 0 To Up - 1 Step 1
If lvCart.Items(Up).SubItems(0).Text <> lvCart.Items(down).SubItems(0).Text Then
ExecuteQry("INSERT INTO tblPurchaseOrder VALUES ('" & lvCart.Items(Up).SubItems(0).Text & "','" & dateCreated & "','" & txtTcost.Text & "','" & lblUserid.Text & "')")
ExecuteQry("INSERT INTO tblPurchaseOrder VALUES ('" & lvCart.Items(down).SubItems(0).Text & "','" & dateCreated & "','" & txtTcost.Text & "','" & lblUserid.Text & "')")
Exit For
Else
End If
Next
Next
if the nested loop found the same PONumber(lvCart.Items().SubItems(0).Text) in the listview it will be save as one transaction my code is working, it saves in the database but it show an error for duplicates

To find duplicates in your list view you can use a Dictionary to help with that. The itemDict will have no duplicates, and the duplicateItems list will contain duplicate items if you need them for some reason.
Private Sub FindListViewDups()
Dim lvCart As New ListView
lvCart.Items.Add("hi")
lvCart.Items.Add("bye")
lvCart.Items.Add("hi")
Dim itemDict As New Dictionary(Of String, String)
Dim duplicateItems As New List(Of String)
For i As Integer = 0 To lvCart.Items.Count - 1
If Not itemDict.ContainsKey(lvCart.Items(i).Text) Then
itemDict.Add(lvCart.Items(i).Text, "")
'Other non-duplicated logic goes here....
Else
duplicateItems.Add(lvCart.Items(i).Text)
End If
Next
End Sub

Related

Variable is crossing different events

Apologies for the vague title, but here is my issue. I have a form that has several select lists and associated text boxes. Basically the way it works is if you select a name from the first list, an AfterUpdate event is triggered to query the DB to see if the Eng_ID and Person_ID already exist in the table. If so, then delete that row then insert the updated row. If there is not any records, then just insert the data. The problem is that when I click a name in the first list, then move to the second list, what's happening is that the the Person_ID of the first list is used for the DLookup query, then it delets the record, then inserts the record of the new person I selected in a different listbox. The code is below: Thanks in advance
' Add/Remove Participant 1
Private Sub lstPar1_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar1
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 1 & ",'" & Me.txtParRole1.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
' Add/Remove Participant 2
Private Sub lstPar2_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar2
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) " & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 2 & ",'" & Me.txtParRole2.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
Using this image, if I select Daniel and enter his role, then the eng_ID, Person_ID, ParticipantNumber and Role are entered into the database as 130, 118, 1, Collaborator.
If I select Kristin, it deletes Daniel becuause it's still using Person_ID of 118 instead of hers which is 134, and since there is a corresponding record, it delets Daniel then adds Kristin.
I don't have Access to test this with, but it seems like you need to separate Participant1 records from Participant2 records when you perform your DLookups.
Also you can generalize your code by pulling the common parts into a separate sub.
Private Sub lstPar1_AfterUpdate()
CheckParticipant Me.lstPar1, 1, Me.txtParRole1.Value
End Sub
Private Sub lstPar2_AfterUpdate()
CheckParticipant Me.lstPar2, 2, Me.txtParRole2.Value
End Sub
Sub CheckParticipant(objList As Object, participantNum As Long, role As String)
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With objList
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n) & _
" And ParticipantNumber=" & participantNum
strSQL = ""
If Not .Selected(n) Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & _
" VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & participantNum & _
",'" & role & "' )"
End If
End If
If Len(strSQL) > 0 Then CurrentDb.Execute strSQL, dbFailOnError
Next n
End With
End Sub

ACCESS 365 and INSERT INTO not inserting data from FORM

I am updating a small medical database. So far all new products have been added manually / directly to a Products- table. I am creating a form to do that.
Even it is in a way very simple to do, I am facing up a problem that data is inserted correctly only if all fields have something typed in form, if any of the input boxes are left empty no new records are made.
Additionally a simple check for minimum fields is not working. It will step thru all controls correctly but does not stop even a field is left empty and its Tag has *-sign in it.
Insert into includes all fields which a defined in that table there is not any extra field in table except first field is autonumbered ID field. No need to type something in every field each time.
Pr
Private Function CheckAllFields() As Boolean
Dim Ctrl As Control
CheckAllFields = False
'Go through the controls in Form
'If control has tag (*) and it null (no value) then show alert
For Each Ctrl In Me.Controls
MsgBox Ctrl.Name
If Ctrl.Tag = "*" And IsNull(Ctrl) Then
Dim FieldName As String
FieldName = Ctrl.Name
'Show notification if field was not filled and move focus to that field
MsgBox "A required Field has not been filled."
Ctrl.SetFocus
CheckAllFields = True
Exit For
End If
Next Ctrl
MsgBox "Check fileds done"
End Function
Private Sub AddProduct_Click()
Dim strSQL As String
'SQL to insert Product
strSQL = "INSERT INTO Products([Product name],[Product description],[Finnish name],[Finnish description],[Matrix2012], " & _
"[Additional Info], [Unit], [Licence],[Remarks],Narcotic,[Asset], " & _
"[ATC], [Cathegory], [EIC code], [EIC name])" & _
" VALUES ('" & Me.txtProductName & "','" & Me.txtProductDesc & "','" & Me.txtFinnishName & "','" & Me.txtFinnishDesc & "','" & Me.ComboMatrix & "'," & _
"'" & Me.txtAdditionalInfo & "','" & Me.ComboUnit & "','" & Me.CheckLicense & "'," & _
"'" & Me.txtRemarks & "','" & Me.CheckNarcotic & "','" & Me.CheckAsset & "'," & _
"'" & Me.txtATC & "','" & Me.txtCathegory & "','" & Me.txtEICcode & "','" & Me.txtEICName & "')"
'' MsgBox strSQL
'Check the all fields have valid format
If CheckAllFields = False Then
'Execute SQL in database - insert new batch
' MsgBox "Step into Check all fields"
CurrentDb.Execute strSQL
MsgBox "A new product inserted !"
End If
Here is a debug output of my insert into command:
Debug output
Here is another output debug, now the new product is inserted correctly.
Correctly working version
Problem solved. As Craig pointed this way of incuding parameters is prone to fail.
Here is good way to solve this. Did not believe it but after I tried it worked ultimate.
MS access running SQL doesn't insert data, no error
strSQL = "INSERT INTO Products([Product name],[Product description],[Finnish name],[Finnish description],[Matrix2012], " & _
"[Additional Info], [Unit], [Licence],[Remarks],Narcotic,[Asset], " & _
"[ATC], [Cathegory], [EIC code], [EIC name])" & _
" VALUES (ptxtProductName, ptxtProductDesc,ptxtFinnishName,ptxtFinnishDesc,pComboMatrix, ptxtAdditionalInfo,pComboUnit, pCheckLicense, ptxtRemarks, pCheckNarcotic, pCheckAsset, ptxtATC, ptxtCathegory, ptxtEICCode, ptxtEICName);"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL)
With qdf
.Parameters("ptxtProductName").Value = Me.txtProductName.Value
.Parameters("ptxtProductDesc").Value = Me.txtProductDesc.Value
.Parameters("ptxtFinnishName").Value = Me.txtFinnishName.Value
.Parameters("ptxtFinnishDesc").Value = Me.txtFinnishDesc.Value
.Parameters("pComboMatrix").Value = Me.ComboMatrix.Value
.Parameters("ptxtAdditionalInfo").Value = Me.txtAdditionalInfo.Value
.Parameters("pComboUnit").Value = Me.ComboUnit.Value
.Parameters("pCheckLicense").Value = Me.CheckLicense.Value
.Parameters("ptxtRemarks").Value = Me.txtRemarks.Value
.Parameters("pCheckNarcotic").Value = Me.CheckNarcotic.Value
.Parameters("pCheckAsset").Value = Me.CheckAsset.Value
.Parameters("ptxtATC").Value = Me.txtATC.Value
.Parameters("ptxtCathegory").Value = Me.txtCathegory.Value
.Parameters("ptxtEICCode").Value = Me.txtEICcode.Value
.Parameters("ptxtEICName").Value = Me.txtEICName.Value
.Execute dbFailOnError
End With
Debug.Print db.RecordsAffected
That check for empty fields is mystery, it works in another form so it has to be some sort of reference problem. Anyway to keep things simple this works perfectly:
If txtProductName.Value = "" Or ComboMatrix.Value = "" Or ComboUnit.Value = "" Then
'Show notification if field was not filled and move focus to that field
MsgBox "A required Field has not been filled."

VSTO Get the fields in "group by" on Groupings in MS Project

How will I get all fields in the "Group By" on a particular group in MS Project, using VSTO vb.net.
I tried this one:
Dim tg As MsProj.Group
Dim strGrp As String = ""
For Each tg In project.TaskGroups
strGrp = strGrp & "/" & vbCrLf & tg.Name
Next
MsgBox(project.TaskGroups("Group 6").GroupCriteria.Count)
Dim qwe As MSProject.GroupCriteria
For Each qwe In project.TaskGroups("Group 6").GroupCriteria
MsgBox(qwe)
Next
but i got error on the 2nd For loop
Thanks,
Gilbert
It appears there is an example for doing just this in the online documentation for the GroupCriterion object. Added here in case that link changes:
Dim GC As GroupCriterion
Dim Fields As String
For Each GC In ActiveProject.TaskGroups("Priority Keeping Outline Structure").GroupCriteria
If GC.Ascending Then
Fields = Fields & GC.Index & ". " & GC.FieldName & " is sorted in ascending order." & vbCrLf
Else
Fields = Fields & GC.Index & ". " & GC.FieldName & " is sorted in descending order." & vbCrLf
End If
Next GC
MsgBox Fields

insert and update in vb.net with access index out of range

i have application i want it to do
1- insert the first statement .
2-get the (maxid) of the invoice
3-insert the detail of the invoice with the Id .
it give me this error
index out of range .
Private Sub insert()
Dim invoiceday As Date = Today
Dim userid As Integer
Dim clientid As Integer
Dim note As String
If clients.Visible = True Then
userid = 1
clientid = 2
note = "cash"
Else
userid = 2
clientid = 6
note = "credit"
End If
Dim query1 As String = " insert into invoices([purchasedate],clientid,[Note],userID,total,disq) Values ( '" & CDate(invoiceday) & "','" & clientid & "','" & note & "','" & userid & "','" & totalprice.Text & "','" & txtdis.Text & "')"
samselect2(query1)
Dim maxinvoice As Integer
maxinvoice = invoiceid()
For Each row As DataGridViewRow In dvsale.Rows
Dim query As String = " insert into invoicede(invoiceid,barcode,doaname,Qty,Price,qtyprice) Values ('" & maxinvoice + 1 & "','" & row.Cells("barcode").Value & "','" & row.Cells("doaname").Value & "','" & row.Cells("qty").Value & "','" & row.Cells("price").Value & "','" & row.Cells("tqty").Value & "')"
samselect2(query)
Next
End Sub
this the class of the samselect2
Public Sub samselect2(ByVal sql As String)
Try
con.Open()
With cmd
.Connection = con
.CommandText = sql
End With
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
con.Close()
da.Dispose()
End Sub
and the invoiceid max number
Private Function invoiceid()
checkConnection()
Dim strQ As String = "SELECT max(invoiceID)as MaxIDbatch from invoices "
Dim cmdQ As OleDbCommand = New OleDbCommand(strQ, con)
Dim result = cmdQ.ExecuteScalar()
If result IsNot Nothing Then
Dim x As Integer = 0
Return x
Else
Return result
End If
End Function
Although I don't fully understand your question, I notice a couple things: 1) It appears that InvoiceID is not an auto-incrementing identity field, and it probably should be. (Check out "Is Identity".) If it were, you could insert and specify all fields except that one, and the number would increment automatically. 2) In your for...each, you are not increasing maxinvoice at all with each iteration through the loop. Although you're using maxinvoice+1, it will still be the same number each time.
Still, all of that should be unnecessary if you make InvoiceID an identity field.

Adding a column to a Farpoint Spread grid

I've never really used Farpoint Spread before, but I have an existing VB.NET application in which I need to add a column to a Spread grid. There is currently some code like:
For Each dr As DataRow In g_AdoRS.Rows
vaSpreadSum.SetText(1, x, dr(0)) 'pol_ser
...
vaSpreadSum.SetText(20, x, dr(19)) 'renew_pay_cd
vaSpreadSum.SetFloat(21, x, dr(20)) 'renew_tot_prem
vaSpreadSum.SetFloat(22, x, dr(21)) 'renew_pol_limit
vaSpreadSum.SetFloat(23, x, dr(22)) 'renew_ded_amt
vaSpreadSum.Col = 28
x = x + 1
Next dr
These SetFloat() and SetText() calls go from 0 to 28. So in order to add another column I added this line of code:
vaSpreadSum.SetText(28, x, dr(27)) 'agent name
and changed the vaSpreadSum.Col to 29
vaSpreadSum.Col = 29
But I am not seeing another column in my grid. Any idea why? There is no error thrown or anything like that, just no changes on the screen. I know there is probably more information needed to solve this, but even if anyone know the basics of adding a column to a Farpoint Spread grid that would be much appreciated. I found this but it doesn't seem that my application is adding columns that way, I couldn't find any calls to the AddColumns() method anywhere.
Thanks for any help!
I believe this is my Form_Load method
Private Sub FrmDetailRPC_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
Cursor.Current = Cursors.WaitCursor
FormInit()
QryLocation()
Cursor.Current = Cursors.Default
End Sub
I'll also include FormInit() because that sounds like it might have to do with what I'm looking for
Sub FormInit()
txtBusUnit.Text = svBusUnit
stmtMktSeg()
txtProduct.Text = svProduct
txtSource.Text = svSource
txtSystem.Text = svSystem
txtCustSeg.Text = svCustSeg
stmtProduct()
txtLocation.Text = svLocation
If svLocationLabel = "Region" Then
lblLocation.Text = "Territory"
Else
lblLocation.Text = svLocationLabel
End If
lblLocation.TextAlign = ContentAlignment.TopRight
stmtLocation()
'txtPayType.Text = svPayType
txtTimePer.Text = TimeName
stmtTimePer()
End Sub
And QryLocation()
Sub QryLocation()
Dim producerID As String
'SetProductSelection()
stmtLocation()
stmtGetProductType()
stmtGetTimePeriodType()
stmtGetTimePeriod()
stmtGetProducerID()
stmtGetProducerType()
If stmtProducerType = "No Preference" Then
producerID = "NULL"
Else
producerID = "'" & stmtProducerID & "'"
End If
g_strSQL = "pc_mis_rpc_getdata_detail " & _
"'" & stmtLocationType & "'," & _
"'" & Trim(svLocation) & "'," & _
"'" & svBusUnit & "'," & _
"'" & stmtProductType & "'," & _
"'" & Trim(stmtProductDtl) & "'," & _
"'" & stmtTimePeriod & "'," & _
"'" & stmtTimePeriodType & "'," & _
"'" & stmtProducerType & "'," & _
producerID & "," & _
"'Retention'" _
& FilterQry & "," & _
"'" & Trim(txtCustSeg.Text) & "'," & _
"'" & Trim(txtSource.Text) & "'," & _
"'" & Trim(txtSystem.Text) & "'"
ProcQry()
End Sub
In your Form_Init() you will need to adjust the number of columns in spread control.
It should look something like this:
Sub FormInit()
' Add a column to the spreadsheet control
vaSpreadSum.ActiveSheet.AddColumns(29, 1)
' Code cut for brevity
End Sub
--or--
Sub FormInit()
' Add a column to the spreadsheet control
vaSpreadSum.ActiveSheet.Columns.Count = 29
' Code cut for brevity
End Sub
Another method for achieving the same thing is to open the form designer, select the spread control, display the properties window (press F4 if it isn't already open), and increase the Cols property to 29.
You increase the column as follows:
vaSpreadSum.MaxCols = 29