Problems with VB... can someone please help??

[RitaMoloney]

Hi,

I have adapted code from ghudson's example on
'http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=52736

I have a subform called frmsJobPartsUsed, which contains a multiselect list box where the user can select multiply parts used for one job and click a save button, which saves the parts to rows on the same forms (see picture). The user then enters the number used and that number is taken away from the UnitsInStock.
This form is made up of the following two tables;
TblStore
PartNo
PartName
UnitsInStock
ReOrderLevel
Discountinued
Remark

tblPartsUsed
PartUsedID
JobDetailsID
PartNo
PartUsedNum
NumberUsed

The multiselect listbox is made form tblStore, PartNo, PartName and Discontinued = 0

This all works fine so far.

What is need to do is before the parts selected are saved to the table I want to run some code to check
If a part’s UnitsInStock is equal to 0 then Message box saying no stock left need to reorder. It won’t save it to the table.
Or else
If UnitsInStock is greater than 0 but less than or equal to ReOrderLevel
Message box saying Stock running low need to reorder asap.

I have this kind of working but it doesn’t seem to be finding the correct UnitsInStock for the part selected.
Here is the code;


Private Sub cmdAnswer_Click() 'SAVE BUTTON
On Error GoTo ErrMsg:

'Code adapted from ghudson's example on
'http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=52736

Dim myFrm As Form, myCtl As Control
Dim mySelection As Variant
Dim iSelected, iCount As Long

Dim myDB As DAO.Database
Dim myRst As DAO.Recordset
Dim myRstCount As DAO.Recordset

Set myDB = CurrentDb()
Set myRst = myDB.OpenRecordset("tblPartsUsed")

Set myFrm = Me
Set myCtl = Me.lstAnswers

iCount = 0
'Count number of selected records/items
For Each mySelection In myCtl.ItemsSelected
iCount = iCount + 1
Next mySelection

'Check if anything is slected
If iCount = 0 Then
MsgBox "There are no Parts selected..", _
vbInformation, "Nothing selected!"

Exit Sub
End If

StrSQLCount = "SELECT tblPartsUsed.JobDetailsID, Count(tblPartsUsed.PartNo) AS CountOfPartNo " & _
"FROM tblPartsUsed " & _
"GROUP BY tblPartsUsed.JobDetailsID " & _
"HAVING (((tblPartsUsed.JobDetailsID)=" & [Forms]![frmJobs]![JobDetailsID] & "));"
Set myRstCount = myDB.OpenRecordset(StrSQLCount, dbOpenSnapshot)




'SART OF MY CODE TO CHECK FOR UNITSINSTOCK

For Each mySelection In myCtl.ItemsSelected
If Me.UnitsInStock.Value = 0 Then
MsgBox "Out of Stock!" & Chr(13) & "Please returen to Orders or Store to Re-Order Stock. " & Chr(13) & " ", vbOKOnly + vbCritical, "Re-Order Stock"
myCtl.Selected(mySelection) = False

Else
If Me.UnitsInStock.Value > 0 And Me.UnitsInStock <= Me.ReOrderLevel.Value Then
MsgBox "The Store is running low on stock!!" & Chr(13) & " Please return to Orders or Store to re-order as soon as possible.", vbInformation, "Need to Re-Order Stock"
End If
End If
Next mySelection
'END





iCount = 0

'Go throught each selected 'record' (ItemsSelected) in listbox
For Each mySelection In myCtl.ItemsSelected
'Current count of selected items
iCount = iCount + 1
'Print value to Immediate Window
Debug.Print myCtl.ItemData(mySelection)
'Add answers
With myRst
.AddNew
.Fields("JobDetailsID") = Forms![frmJobs]![JobDetailsID]
.Fields("PartUsedNum") = iCount
.Fields("PartNo") = myCtl.ItemData(mySelection)
.Update
End With
Next mySelection

'Requery form
Me.Requery

ResumeHere:
Exit Sub

ErrMsg:
MsgBox "Error Number: " & Err.Number & _
"Error Description: " & Err.Description & _
"Error Source: " & Err.Source, vbCritical, "Error!"
Resume ResumeHere:

End Sub



Private Sub cmdUnselect_Click() 'UNSELECT BUTTON
On Error GoTo ErrMsg:

'Code adapted from ghudson's example on
'http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=52736

Dim myFrm As Form, myCtl As Control
Dim mySelection As Variant
Dim iSelected, iCount As Long

Set myFrm = Me
Set myCtl = Me.lstAnswers

'Count number of selected records/items
For Each mySelection In myCtl.ItemsSelected
iCount = iCount + 1
Next mySelection

If iCount = 0 Then
MsgBox "There are no selections to Un-Select..", _
vbInformation, "Nothing selected!"
End If

'Go throught each selected 'record' (ItemsSelected) in listbox
For Each mySelection In myCtl.ItemsSelected
Debug.Print myCtl.ItemData(mySelection)
myCtl.Selected(mySelection) = False
Next mySelection

ResumeHere:
Exit Sub

ErrMsg:
MsgBox "Error Number: " & Err.Number & _
"Error Description: " & Err.Description & _
"Error Source: " & Err.Source, vbCritical, "Error!"
Resume ResumeHere:
End Sub







Any help would be greatly appreciated.
Thanks in advance
Rita