By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,701 Members | 1,966 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,701 IT Pros & Developers. It's quick & easy.

Trying To Select A record Using The Listbox

P: 12
I have a form called the sales form and i have 2 sets of listboxes
So what happens is. i add items form the bottom set of list boxes which are bound to a data base to the top set of list boxes which are not bound, I select from the bottom set and add to the top set which works fine, but now i decide to remove an item from the top set.

when i tried to use a remove item code it worked fine, it did delete the item form the list but it added the quantity number to the record where the pointer was at that particular time, so it added cups quantity to saucers quantity. So i now have to less cups and two more saucers

How can i select the item on the top set of list boxes and make it select the right record in the database to return the item. If i select the eg the third item in the listbox and click a return or delete from list button it selects the correct record from the database and does the updating.
I have searched the scripts webpages till my eyes are sore and googled for weeks but could not find a solution

I am using VB6 with Access97 database

I posted my whole code here in the hopes that you experts out there can help me make sense out of this. Can anyone help me, and while you are at it please tell me if i'm going about this in the right way and if i'm missing it completely.

Many Thanks

Dim db As Database
Dim rs As Recordset
Private Sub Command1_Click()
List1.Visible = True
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description from items")

DoEvents
List1.Clear
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs!Item
rs.MoveNext
Wend
rs.Close
End Sub

Private Sub Command2_Click()
List1.Visible = True
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description,SellingPrice from items")

DoEvents
List1.Clear
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs!Item & Space(5) & rs!Description & Space(5) & rs!SellingPrice & Space(5)

rs.MoveNext
Wend
rs.Close

End Sub

Private Sub Command3_Click()
List2.Clear
End Sub

Private Sub Command4_Click()
On Error GoTo fout
List2.RemoveItem List2.ListIndex
fout:
Exit Sub
End Sub

Private Sub Command7_Click()
'LISTBOX nITEMS
nListItem = Me.List1.ListCount
Me.Label2.Caption = "SORTED RECORDS: " & Me.List1.ListCount
'REDIM PUBLIC ARRAY
ReDim ITEM1_2SORT(0 To nListItem - 1)
ReDim ITEM2_2SORT(0 To nListItem - 1)
ReDim ITEM3_2SORT(0 To nListItem - 1)
'LOAD FROM LISTBOX TO ARRAY
For nITEM = 0 To Me.List3.ListCount - 1
ITEM1_2SORT(nITEM) = Me.List1.List(nITEM)
ITEM2_2SORT(nITEM) = Me.List2.List(nITEM)
ITEM3_2SORT(nITEM) = Me.List3.List(nITEM)
Next
'CALL SORTING ROUTINE
Call List1SORT(ITEM1_2SORT())
'CLEAR LISTBOX
Me.List1.Clear
Me.List2.Clear
Me.List3.Clear
'RELOAD LISTBOX FROM SORTED ARRAY
For nITEM = 0 To nListItem - 1
Me.List1.AddItem ITEM1_2SORT(nITEM)
Me.List2.AddItem ITEM2_2SORT(nITEM)
Me.List3.AddItem ITEM3_2SORT(nITEM)
Next
End Sub

Private Sub Command5_Click()
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select QtyInStock from items")
rs.Edit
rs.Fields("QtyInStock") = 20
rs.Update
rs.Close

Label30.Visible = True
ProgressBar1.Visible = True
ProgressBar1.Min = 0
ProgressBar1.Max = 100
ProgressBar1.Value = 0
Timer2.Enabled = True
Timer2.Interval = 20

Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description,SellingPrice,BrandName,QtyInStock from items")
DoEvents
List7.Clear
rs.MoveFirst
While Not rs.EOF
List7.AddItem rs!QtyInStock
rs.MoveNext
Wend

End Sub

Private Sub Command6_Click()
' Add ColumnHeaders. The width of the columns is
' the width of the control divided by the number of
' ColumnHeader objects.
ListView1.ColumnHeaders. _
Add , , "Item", ListView1.Width / 3
ListView1.ColumnHeaders. _
Add , , "Description", ListView1.Width / 3, _
lvwColumnCenter
ListView1.ColumnHeaders. _
Add , , "Price", ListView1.Width / 3
' Set View property to Report.
ListView1.View = lvwReport

' Declare object variables for the
' Data Access objects.
Dim myDb As Database, myRs As Recordset
' Set the Database to the BIBLIO.MDB database.
' IMPORTANT: the Biblio.mdb must be on your
' machine, and you must set the correct path to
' the file in the OpenDatabase function below.
Set myDb = DBEngine.Workspaces(0) _
.OpenDatabase("c:\Stocksdb1.MDB")
' Set the recordset to the "Authors" table.
Set myRs = _
myDb.OpenRecordset("items", dbOpenDynaset)

' Declare a variable to add ListItem objects.
Dim itmX As ListItem

' While the record is not the last record,
' add a ListItem object. Use the author field for
' the ListItem object's text. Use the AuthorID
' field for the ListItem object's SubItem(1).
' Use the "Year of Birth" field for the ListItem
' object's SubItem(2).

While Not myRs.EOF
Set itmX = ListView1.ListItems. _
Add(, , CStr(myRs!Item)) ' items.

' If the AuthorID field is not null, then set
' SubItem 1 to it.
If Not IsNull(myRs!Description) Then
itmX.SubItems(1) = CStr(myRs!Description)
End If

' If the birth field is not Null, set
' SubItem 2 to it.
If Not IsNull(myRs![SellingPrice]) Then
itmX.SubItems(2) = myRs![SellingPrice]
End If
myRs.MoveNext ' Move to next record.
Wend
End Sub

Private Sub Form_Load()
Me.Top = 1390
Me.Left = 0
Me.Height = 7100
Label2 = Date
Time = Now
Timer1.Enabled = True
Timer1.Interval = 1000

Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description,SellingPrice,BrandName,QtyInStock from items")

DoEvents
List1.Clear
List2.Clear
List3.Clear
List7.Clear
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs!Item
List2.AddItem rs!Description

List7.AddItem rs!QtyInStock
rs.MoveNext
Wend
rs.Close


Data2.Refresh
frmsales.List1.Refresh
frmsales.List2.Refresh
frmsales.List3.Refresh
frmsales.List7.Refresh







End Sub

Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)
' Add ColumnHeaders. The width of the columns is
' the width of the control divided by the number of
' ColumnHeader objects.
ListView1.ColumnHeaders. _
Add , , "Author", ListView1.Width / 3
ListView1.ColumnHeaders. _
Add , , "Author ID", ListView1.Width / 3, _
lvwColumnCenter
ListView1.ColumnHeaders. _
Add , , "Birthdate", ListView1.Width / 3
' Set View property to Report.
ListView1.View = lvwReport

' Declare object variables for the
' Data Access objects.
Dim myDb As Database, myRs As Recordset
' Set the Database to the BIBLIO.MDB database.
' IMPORTANT: the Biblio.mdb must be on your
' machine, and you must set the correct path to
' the file in the OpenDatabase function below.
Set myDb = DBEngine.Workspaces(0) _
.OpenDatabase("c:\Program Files\VB\BIBLIO.MDB")
' Set the recordset to the "Authors" table.
Set myRs = _
myDb.OpenRecordset("Authors", dbOpenDynaset)

' Declare a variable to add ListItem objects.
Dim itmX As ListItem

' While the record is not the last record,
' add a ListItem object. Use the author field for
' the ListItem object's text. Use the AuthorID
' field for the ListItem object's SubItem(1).
' Use the "Year of Birth" field for the ListItem
' object's SubItem(2).

While Not myRs.EOF
Set itmX = ListView1.ListItems. _
Add(, , CStr(myRs!Author)) ' Author.

' If the AuthorID field is not null, then set
' SubItem 1 to it.
If Not IsNull(myRs!Au_id) Then
itmX.SubItems(1) = CStr(myRs!Au_id)
End If

' If the birth field is not Null, set
' SubItem 2 to it.
If Not IsNull(myRs![Year Born]) Then
itmX.SubItems(2) = myRs![Year Born]
End If
myRs.MoveNext ' Move to next record.
Wend

End Sub



Private Sub Label13_Click()
End Sub

Private Sub List1_Click()
Me.List2.TopIndex = Me.List1.TopIndex
Me.List2.ListIndex = Me.List1.ListIndex
Me.List7.ListIndex = Me.List1.ListIndex
Me.List1.TopIndex = Me.List7.TopIndex
Me.List7.TopIndex = Me.List2.TopIndex
Me.List1.ListIndex = Me.List2.ListIndex




Label24.Caption = List5.Text
End Sub

Private Sub List2_Click()
Me.List1.TopIndex = Me.List2.TopIndex
Me.List3.TopIndex = Me.List2.TopIndex
Me.List1.ListIndex = Me.List2.ListIndex



End Sub

Private Sub List3_Click()
Me.List1.TopIndex = Me.List3.TopIndex
Me.List2.TopIndex = Me.List3.TopIndex
Me.List1.ListIndex = Me.List3.ListIndex
Me.List2.ListIndex = Me.List3.ListIndex
Label12.Caption = List3.Text
Label24.Caption = List5.Text
End Sub

Private Sub List4_Click()
Me.List4.TopIndex = Me.List5.TopIndex
Me.List5.ListIndex = Me.List4.ListIndex
Me.List6.ListIndex = Me.List4.ListIndex
Label24.Caption = List5.Text
Label25.Caption = List6.Text
End Sub

Private Sub List5_Click()
Me.List6.ListIndex = Me.List4.ListIndex
Me.List5.TopIndex = Me.List4.TopIndex
Me.List4.ListIndex = Me.List5.ListIndex
Label24.Caption = List5.Text
Label25.Caption = List6.Text
End Sub



Private Sub List6_Click()
Me.List6.ListIndex = Me.List6.ListIndex
Me.List5.TopIndex = Me.List6.TopIndex
Me.List4.ListIndex = Me.List6.ListIndex
Label24.Caption = List5.Text
Label25.Caption = List6.Text
End Sub

Private Sub List7_Click()

frmsales.List1.Refresh
frmsales.List2.Refresh
frmsales.List3.Refresh
frmsales.List7.Refresh
End Sub

Private Sub lvButtons_H2_Click()
'The Remove Item Button
On Error GoTo fout
List4.RemoveItem List4.ListIndex
List5.RemoveItem List5.ListIndex
List6.RemoveItem List6.ListIndex
Dim e As Long
e = Label21.Caption - Label25.Caption
Label21.Caption = e
fout:
Exit Sub
End Sub

Private Sub lvButtons_H3_Click()
List4.Clear
List5.Clear
List6.Clear
Label21.Caption = 0
End Sub

Private Sub lvButtons_H4_Click()
Picture2.Visible = True
End Sub



Private Sub lvButtons_H5_Click()
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description,SellingPrice,BrandName,QtyInStock from items")

DoEvents
List1.Clear
List2.Clear
List3.Clear
List7.Clear
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs!Item
List2.AddItem rs!Description
List3.AddItem rs!SellingPrice
List7.AddItem rs!QtyInStock
rs.MoveNext
Wend
rs.Close

'LISTBOX nITEMS
nListItem = Me.List1.ListCount
Me.Label10.Caption = "SORTED RECORDS: " & Me.List1.ListCount
'REDIM PUBLIC ARRAY
ReDim ITEM1_2SORT(0 To nListItem - 1)
ReDim ITEM2_2SORT(0 To nListItem - 1)
ReDim ITEM3_2SORT(0 To nListItem - 1)
'LOAD FROM LISTBOX TO ARRAY
For nITEM = 0 To Me.List3.ListCount - 1
ITEM1_2SORT(nITEM) = Me.List1.List(nITEM)
ITEM2_2SORT(nITEM) = Me.List2.List(nITEM)
ITEM3_2SORT(nITEM) = Me.List3.List(nITEM)
Next
'CALL SORTING ROUTINE
Call List1SORT(ITEM1_2SORT())
'CLEAR LISTBOX
Me.List1.Clear
Me.List2.Clear
Me.List3.Clear
'RELOAD LISTBOX FROM SORTED ARRAY
For nITEM = 0 To nListItem - 1
Me.List1.AddItem ITEM1_2SORT(nITEM)
Me.List2.AddItem ITEM2_2SORT(nITEM)
Me.List3.AddItem ITEM3_2SORT(nITEM)
Next
End Sub

Private Sub lvButtons_H6_Click()

Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description,SellingPrice,BrandName from items")

DoEvents
List1.Clear
List2.Clear
List3.Clear
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs!Item
List2.AddItem rs!Description
List3.AddItem rs!SellingPrice
rs.MoveNext
Wend
rs.Close

'LISTBOX nITEMS
nListItem = Me.List1.ListCount
Me.Label10.Caption = "SORTED RECORDS: " & Me.List1.ListCount
'REDIM PUBLIC ARRAY
ReDim ITEM1_2SORT(0 To nListItem - 1)
ReDim ITEM2_2SORT(0 To nListItem - 1)
ReDim ITEM3_2SORT(0 To nListItem - 1)
'LOAD FROM LISTBOX TO ARRAY
For nITEM = 0 To Me.List3.ListCount - 1
ITEM1_2SORT(nITEM) = Me.List1.List(nITEM)
ITEM2_2SORT(nITEM) = Me.List2.List(nITEM)
ITEM3_2SORT(nITEM) = Me.List3.List(nITEM)
Next
'CALL SORTING ROUTINE
Call List2SORT(ITEM2_2SORT())
'CLEAR LISTBOX
Me.List1.Clear
Me.List2.Clear
Me.List3.Clear
'RELOAD LISTBOX FROM SORTED ARRAY
For nITEM = 0 To nListItem - 1
Me.List1.AddItem ITEM1_2SORT(nITEM)
Me.List2.AddItem ITEM2_2SORT(nITEM)
Me.List3.AddItem ITEM3_2SORT(nITEM)
Next
End Sub

Private Sub lvButtons_H7_Click()
Set db = DBEngine.Workspaces(0).OpenDatabase("c:\Stocksdb1. mdb", False, False)
Set rs = db.OpenRecordset("Select Item,Description,SellingPrice,BrandName from items")

DoEvents
List1.Clear
List2.Clear
List3.Clear
rs.MoveFirst
While Not rs.EOF
List1.AddItem rs!Item
List2.AddItem rs!Description
List3.AddItem rs!SellingPrice
rs.MoveNext
Wend
rs.Close

'LISTBOX nITEMS
nListItem = Me.List1.ListCount
Me.Label10.Caption = "SORTED RECORDS: " & Me.List1.ListCount
'REDIM PUBLIC ARRAY
ReDim ITEM1_2SORT(0 To nListItem - 1)
ReDim ITEM2_2SORT(0 To nListItem - 1)
ReDim ITEM3_2SORT(0 To nListItem - 1)
'LOAD FROM LISTBOX TO ARRAY
For nITEM = 0 To Me.List3.ListCount - 1
ITEM1_2SORT(nITEM) = Me.List1.List(nITEM)
ITEM2_2SORT(nITEM) = Me.List2.List(nITEM)
ITEM3_2SORT(nITEM) = Me.List3.List(nITEM)
Next
'CALL SORTING ROUTINE
Call List3SORT(ITEM3_2SORT())
'CLEAR LISTBOX
Me.List1.Clear
Me.List2.Clear
Me.List3.Clear
'RELOAD LISTBOX FROM SORTED ARRAY
For nITEM = 0 To nListItem - 1
Me.List1.AddItem ITEM1_2SORT(nITEM)
Me.List2.AddItem ITEM2_2SORT(nITEM)
Me.List3.AddItem ITEM3_2SORT(nITEM)
Next
End Sub

Private Sub lvButtons_H8_Click()
If Text1 = "" Or Val(Text1) > Val(Label29) Then
frmsales.Enabled = False
frmMain.Enabled = False
FrmQtyRqd.Show
GoTo nostock
Else
Dim a As Integer
a = Val(Label12) * Val(Text1)
Label13.Caption = a
List4.AddItem Text1.Text & vbTab & List1.Text & vbTab & List2.Text
List5.AddItem "R" & List3.Text
List6.AddItem "R" & Label13.Caption
End If

Dim b As Integer
b = Val(Label21) + Val(Label13)
Label21.Caption = b
nostock:

End Sub


Private Sub Timer2_Timer()
If ProgressBar1.Value < 100 Then
ProgressBar1.Value = ProgressBar1.Value + 1
Dim pr As Long
pr = ProgressBar1.Value
Label30.Caption = "Processing Transction " & pr & "% Done"
Else
Timer2.Enabled = False
ProgressBar1.Value = 0
ProgressBar1.Visible = False
Label30.Visible = False
Data2.Refresh
frmsales.List1.Refresh
frmsales.List2.Refresh
frmsales.List3.Refresh
frmsales.List7.Refresh

End If

End Sub
Sep 26 '07 #1
Share this Question
Share on Google+
1 Reply


P: 12
Hi Guys

I am still no closer to an answer than i was before is the anyone out there who can help me please. My whole code is here and i will even send a zipfile to anyone with the entire application if you want and see if you can help me with a method to the madness.
Oct 3 '07 #2

Post your reply

Sign in to post your reply or Sign up for a free account.