MultiSelect ListBox Code posted J. Vinson - Help, please!!

[Guest]

On January 21, 2005, John Vinson posted code pertaiing to assigning multiple
selections from a ListBox to a table. I've taken his code, and modified it
for my use on a project I am working on, and it works beautifully (Thank you,
John!!)

The problem I am having is that when I run the code from a Save button, it
creates a blank entry first, and then it will create the record entries that
I need. How do I get rid of the blank entry?

Private Sub btn_Save_Click()

' Modified form original code provided by John Vinson

On Error GoTo PROC_ERR

Dim iItem As Long
Dim lngDP As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset

' save the current record if it's not saved
'If Me.Dirty = True Then
'Me.Dirty = False
'End If

Set db = CurrentDb
' Open a Recordset based on the table
Set rs = db.OpenRecordset("tbl_DP_Assignments", dbOpenDynaset)
With Me!lstDeskProcedures
' Loop through all rows in the Listbox
For iItem = 1 To .ListCount - 1
lngDP = .Column(3, iItem)
' Determine whether this PositionID-DPID combination is currently
' in the table
rs.FindFirst "[Position_ID] = " & Me.[Position_ID] & " AND " &
"[DP_ID] = " & lngDP
If rs.NoMatch Then ' this item has not been added
If .Selected(iItem) Then
' add it
rs.AddNew
'rs!DP_Assignment_ID = Me.DP_Assignment_ID
rs!Position_ID = Me.[Position_ID]
rs!DP_ID = lngDP
'rs!Date_Assigned = Me.Date_Assigned
rs.Update
End If ' if it wasn't selected, ignore it
'Else
'If Not .Selected(iItem) Then
' delete this record if it's been deselected
'rs.Delete
'End If ' if it was selected, leave it alone
End If
Next iItem
End With
rs.Close
Set rs = Nothing
Set db = Nothing

Me.Requery

DoCmd.Close , , acSaveNo



PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox "Error " & Err.Number & " in btn_Save_Click:" _
& vbCrLf & Err.Description
Resume PROC_EXIT

End Sub


I've set the ListBox to show Headers based upon another post I read, but it
hasn't helped the issue. I'm not sure, but I think that the addtion of the
blank entry (Position_ID shows up, DP_ID does not) might have something to do
with the form opening and closing.

Does anyone have any suggestions? I thought about taking the easy way out,
and coding a delete query to run after the addition of the new records, but
I'd rather resolve the matter the right way.

Any help would be appreciated greatly.

Michael Koenig

 

[Douglas J. Steele]

Not sure why you're getting a blank row, but the items in a listbox range
from 0 to .ListCount - 1, not from 1 to .ListCount - 1. However, your code
doesn't look as efficient as it could be. Why bother looking up whether the
PositionID-DPID combination is in the table if you're only going to do
something if that row's been selected?


Dim iItem As Long
Dim lngDP As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim varItem as Variant

Set db = CurrentDb
' Open a Recordset based on the table
Set rs = db.OpenRecordset("tbl_DP_Assignments", dbOpenDynaset)
With Me!lstDeskProcedures
' Loop through all selected rows in the Listbox
For Each varItem In .ItemsSelected
lngDP = .Column(3, varItem)
' Determine whether this PositionID-DPID combination is
currently
' in the table
rs.FindFirst "[Position_ID] = " & Me.[Position_ID] & " AND " &
"[DP_ID] = " & lngDP
If rs.NoMatch Then ' this item has not been added
' add it
rs.AddNew
rs!Position_ID = Me.[Position_ID]
rs!DP_ID = lngDP
rs.Update
End If
Next varItem
End With
rs.Close
Set rs = Nothing
Set db = Nothing


--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

On January 21, 2005, John Vinson posted code pertaiing to assigning
multiple
selections from a ListBox to a table. I've taken his code, and modified it
for my use on a project I am working on, and it works beautifully (Thank
you,
John!!)

The problem I am having is that when I run the code from a Save button, it
creates a blank entry first, and then it will create the record entries
that
I need. How do I get rid of the blank entry?

Private Sub btn_Save_Click()

' Modified form original code provided by John Vinson

On Error GoTo PROC_ERR

Dim iItem As Long
Dim lngDP As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset

' save the current record if it's not saved
'If Me.Dirty = True Then
'Me.Dirty = False
'End If

Set db = CurrentDb
' Open a Recordset based on the table
Set rs = db.OpenRecordset("tbl_DP_Assignments", dbOpenDynaset)
With Me!lstDeskProcedures
' Loop through all rows in the Listbox
For iItem = 1 To .ListCount - 1
lngDP = .Column(3, iItem)
' Determine whether this PositionID-DPID combination is
currently
' in the table
rs.FindFirst "[Position_ID] = " & Me.[Position_ID] & " AND " &
"[DP_ID] = " & lngDP
If rs.NoMatch Then ' this item has not been added
If .Selected(iItem) Then
' add it
rs.AddNew
'rs!DP_Assignment_ID = Me.DP_Assignment_ID
rs!Position_ID = Me.[Position_ID]
rs!DP_ID = lngDP
'rs!Date_Assigned = Me.Date_Assigned
rs.Update
End If ' if it wasn't selected, ignore it
'Else
'If Not .Selected(iItem) Then
' delete this record if it's been deselected
'rs.Delete
'End If ' if it was selected, leave it alone
End If
Next iItem
End With
rs.Close
Set rs = Nothing
Set db = Nothing

Me.Requery

DoCmd.Close , , acSaveNo



PROC_EXIT:
Exit Sub

PROC_ERR:
MsgBox "Error " & Err.Number & " in btn_Save_Click:" _
& vbCrLf & Err.Description
Resume PROC_EXIT

End Sub


I've set the ListBox to show Headers based upon another post I read, but
it
hasn't helped the issue. I'm not sure, but I think that the addtion of the
blank entry (Position_ID shows up, DP_ID does not) might have something to
do
with the form opening and closing.

Does anyone have any suggestions? I thought about taking the easy way out,
and coding a delete query to run after the addition of the new records,
but
I'd rather resolve the matter the right way.

Any help would be appreciated greatly.

Michael Koenig

 

[Dirk Goldgar]

Not sure why you're getting a blank row, but the items in a listbox
range from 0 to .ListCount - 1, not from 1 to .ListCount - 1.

If the list box has its ColumnHeads property set, row 0 is the header
row and can be excluded.

 

[Douglas J. Steele]

If the list box has its ColumnHeads property set, row 0 is the header
row and can be excluded.

Thanks, Dirk. I've never turned the ColumnHeads property on. Does that mean
ListCount is increased by 1?

 

[Ken Snell [MVP]]

ListCount is the total number of rows in the list plus the header row. So if
you have 5 rows plus header row, ListCount = 6. Without the header row, it's
= 5.