G
GGill
How to Move List Box Items to Another List Box in a form.
I have two list boxes and command buttons. Please help me to figure out what
i am doing wrong in my code;
=========
Option Compare Database
Private Sub LoadAvailable()
On Error GoTo Err_LoadAvailable
Dim intItem As Integer
Dim strZoneID As String
Dim strCriteria As String
Dim strSQL As String
Dim bolFirst As Boolean
Dim dq As String
dq = Chr(34) ' double quote
strCriteria = ""
bolFirst = True
With lstSelected
For intItem = 1 To .ListCount
strZoneID = dq & .Column(0, intItem - 1) & dq
If bolFirst Then
strCriteria = strZoneID
bolFirst = False
Else
strCriteria = strCriteria & "," & strZoneID
End If
Next
End With
strSQL = "SELECT tblInfo.id, tblInfo.name FROM tblInfo"
If strCriteria <> "" Then
strSQL = strSQL & " WHERE tblInfo.id NOT IN (" & strCriteria & ")"
End If
strSQL = strSQL & " ORDER BY id"
With lstAvailable
.RowSourceType = "Table/Query"
.RowSource = strSQL
.Requery
End With
Exit_LoadAvailable:
Exit Sub
Err_LoadAvailable:
MsgBox Err.Description
Resume Exit_LoadAvailable
End Sub
----------------------------------
Private Sub cmdMove_Click()
On Error GoTo Err_cmdMove_Click
Dim varItem As Variant
Dim varValue As Variant
Dim isOk2Add As Boolean
With lstAvailable
For Each varItem In lstAvailable.ItemsSelected
If IsNull(lstSelected.RowSource) Then
isOk2Add = True
Else
isOk2Add = (InStr(1, lstSelected.RowSource, .Column(0,
varItem)) = 0)
End If
If isOk2Add Then
varValue = lstSelected.Column(0, varItem) & ";" &
lstSelected.Column(1, varItem)
lstSelected.AddItem Item:=varItem ' I am stuck here (can not
find object)
Next varItem
End With
LoadAvailable
Exit_cmdMove_Click:
Exit Sub
Err_cmdMove_Click:
MsgBox Err.Description
Resume Exit_cmdMove_Click
End Sub
---------------------------------
Private Sub Form_Load()
On Error GoTo Err_Form_Load
LoadAvailable
Exit_Form_Load:
Exit Sub
Err_Form_Load:
MsgBox Err.Description
Resume Exit_Form_Load
End Sub
I have two list boxes and command buttons. Please help me to figure out what
i am doing wrong in my code;
=========
Option Compare Database
Private Sub LoadAvailable()
On Error GoTo Err_LoadAvailable
Dim intItem As Integer
Dim strZoneID As String
Dim strCriteria As String
Dim strSQL As String
Dim bolFirst As Boolean
Dim dq As String
dq = Chr(34) ' double quote
strCriteria = ""
bolFirst = True
With lstSelected
For intItem = 1 To .ListCount
strZoneID = dq & .Column(0, intItem - 1) & dq
If bolFirst Then
strCriteria = strZoneID
bolFirst = False
Else
strCriteria = strCriteria & "," & strZoneID
End If
Next
End With
strSQL = "SELECT tblInfo.id, tblInfo.name FROM tblInfo"
If strCriteria <> "" Then
strSQL = strSQL & " WHERE tblInfo.id NOT IN (" & strCriteria & ")"
End If
strSQL = strSQL & " ORDER BY id"
With lstAvailable
.RowSourceType = "Table/Query"
.RowSource = strSQL
.Requery
End With
Exit_LoadAvailable:
Exit Sub
Err_LoadAvailable:
MsgBox Err.Description
Resume Exit_LoadAvailable
End Sub
----------------------------------
Private Sub cmdMove_Click()
On Error GoTo Err_cmdMove_Click
Dim varItem As Variant
Dim varValue As Variant
Dim isOk2Add As Boolean
With lstAvailable
For Each varItem In lstAvailable.ItemsSelected
If IsNull(lstSelected.RowSource) Then
isOk2Add = True
Else
isOk2Add = (InStr(1, lstSelected.RowSource, .Column(0,
varItem)) = 0)
End If
If isOk2Add Then
varValue = lstSelected.Column(0, varItem) & ";" &
lstSelected.Column(1, varItem)
lstSelected.AddItem Item:=varItem ' I am stuck here (can not
find object)
Next varItem
End With
LoadAvailable
Exit_cmdMove_Click:
Exit Sub
Err_cmdMove_Click:
MsgBox Err.Description
Resume Exit_cmdMove_Click
End Sub
---------------------------------
Private Sub Form_Load()
On Error GoTo Err_Form_Load
LoadAvailable
Exit_Form_Load:
Exit Sub
Err_Form_Load:
MsgBox Err.Description
Resume Exit_Form_Load
End Sub