Removing List Items

[Rocks]

Hi All,

I am trying to remove an item from one list and place it into another. I keep getting a "Invalid property array index" error. I know that if I set iCount to iPos = iCount - 2 it will work but it moves the item that is two places above it out of the list.

Can anyone Help / Advise me PLEASE?

Private Sub cmdRemoveHighlighted_Click()

Dim iCount As Integer
Dim iPos As Integer

iPos = 0

'Total count of list items on RHS
iCount = lstQueryList.ListCount

'Loop through the list
C = iCount - 1
For iPos = 0 To C
' MsgBox lstQueryList.List(iPos)
If lstQueryList.Selected(iPos) Then
'Add item to LHS list
lstAllData.AddItem (lstQueryList.List(iPos))
'Remove Selected item on list
lstQueryList.Selected(iPos) = False
lstQueryList.RemoveItem (lstQueryList.Selected(iPos))
fraData.Refresh
End If

Next iPos


End Sub


Thanks in advance,

Rocks

[HughLacey]

I use the following code which may be of use. The two lists I'm using need to maintain the orginal order so the itemdata property is initialised withe the orginal position in the list there are also methods to move items up and down in the list. You can remove this if you don't need it.

Create a form with two list boxes lst1 & lst2 and 2 buttons cmd1 and cmd2.

Form Code:

Option Explicit

Private Sub cmd1_Click()
MoveSelectedItems lst1, lst2, False, True
End Sub

Private Sub cmd2_Click()
MoveSelectedItems lst2, lst1, False, True
End Sub

Private Sub Form_Load()

Dim i As Integer

For i = 1 To 10
lst1.AddItem Str(i)
lst1.itemdata(lst1.NewIndex) = i
Next i

End Sub


Add a module (modListBoxFuncs):

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Any, ByVal lParam As Any) As Long
Private Const LB_SETSEL = &H185&
Private Const LB_GETSELCOUNT = &H190
Private Const LB_GETSELITEMS = &H191

Public Sub ClearSelections(lst As ListBox)
Call SendMessage(lst.hwnd, LB_SETSEL, CLng(False), ByVal CLng(-1))
End Sub

Public Sub MoveSelectedItems(lstSrc As ListBox, lstTgt As ListBox, Optional moveAll As Boolean = False, Optional useorder As Boolean = False)

Dim i%, s%, p%, pos%
Dim numSelected As Long

numSelected = SendMessage(lstSrc.hwnd, LB_GETSELCOUNT, 0&, ByVal 0&)

If numSelected > 0 Or moveAll Then
With lstTgt
ClearSelections lstTgt
i = 0
Do While i < lstSrc.ListCount
If lstSrc.Selected(i) Or moveAll Then
If useorder Then
pos = lstSrc.itemdata(i)
For p = 0 To .ListCount - 1
If .itemdata(p) > pos Then
pos = p
Exit For
End If
Next p
If pos > .ListCount Then pos = .ListCount
Else
pos = .ListCount
End If
.Enabled = True
.AddItem lstSrc.List(i), pos
.itemdata(.NewIndex) = lstSrc.itemdata(i)
.Selected(.NewIndex) = True
lstSrc.RemoveItem i
s = i
Else
i = i + 1
End If
Loop
End With
End If

If lstSrc.ListCount > 0 Then
If s > 0 Then s = s - 1
lstSrc.Selected(s) = True
lstSrc.Enabled = True
Else
lstSrc.Enabled = False
End If

End Sub

Public Sub PromoteSelectedItems(lst As ListBox)

Dim i%
Dim item$
Dim itemdata

With lst
If Not .Selected(0) Then
For i = 1 To .ListCount - 1
If .Selected(i) Then
item = .List(i)
itemdata = .itemdata(i)
.RemoveItem i
.AddItem item, i - 1
.itemdata(.NewIndex) = itemdata
.Selected(.NewIndex) = True
End If
Next i
End If
End With

End Sub

Public Sub DemoteSelectedItems(lst As ListBox)

Dim i%
Dim item$
Dim itemdata

With lst
If Not .Selected(.ListCount - 1) Then
For i = .ListCount - 2 To 0 Step -1
If .Selected(i) Then
item = .List(i)
itemdata = .itemdata(i)
.RemoveItem i
.AddItem item, i + 1
.itemdata(.NewIndex) = itemdata
.Selected(.NewIndex) = True
End If
Next i
End If
End With

End Sub

[Rocks]

Thanks for your reply,

But would you know why the Code I have written does not work??

Regards,

Rocks

[Chris]

I think this will be better & faster, because you no need to loop through the entire list item.

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LB_ERR = (-1)
Private Const LB_GETCURSEL = &H188

Private Sub Command1_Click()
Dim Idx As Integer
'Get the current list index
Idx = SendMessage(lstQueryList.hwnd, LB_GETCURSEL, 0, 0)
'If not error
If Idx <> LB_ERR Then
    lstAllData.AddItem lstQueryList.List(Idx)
    lstQueryList.RemoveItem Idx
End If
End Sub

[HughLacey]

Rocks

I think your code is broken because your For/next Loop is set to the listCount size of the original listbox when you start removing items the ListCount property will change!

Hugh

[HughLacey]

Chris,

Your code only works for a single selected item, the code I posted is for extended selections.

Hugh

[paulw]

The problem is incredibly simple. Rocks, you are removing Items and as Hugh says, your ListCount changes (and so do the indices). The way to do it is to loop through the list backwards...

Instead of For iPos = 0 To C

Use

For iPos = C To 0 Step -1

Cheers,

P.

[Chris]

Hi! HughLacey, this sample code if for both single or multiple item selection. Yet it need to to loop through the entire list item.

Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LB_ERR = (-1)
Private Const LB_GETCURSEL = &H188
Private Const LB_GETSELCOUNT = &H190
Private Const LB_GETSELITEMS = &H191

Private Sub Command1_Click()
Dim i As Integer
Dim Idx As Integer
Dim sCount As Integer
Dim sBuff(512) As Long

'Get the number of selected item
sCount = SendMessage(lstQueryList.hwnd, LB_GETSELCOUNT, 0, 0)
If sCount = 1 Then
    Idx = SendMessage(lstQueryList.hwnd, LB_GETCURSEL, 0, 0)
    lstAllData.AddItem lstQueryList.List(Idx)
    lstQueryList.RemoveItem Idx
Else
    If sCount < 512 Then
        Idx = SendMessage(lstQueryList.hwnd, LB_GETSELITEMS, 512, sBuff(0))
        For i = Idx - 1 To 0 Step -1
            lstAllData.AddItem lstQueryList.List(sBuff(i))
            lstQueryList.RemoveItem sBuff(i)
        Next
    Else
        MsgBox "Too many selected item!", vbExclamation + vbOKOnly, "ListBox"
    End If
End If
End Sub