Listbox Selection

[mdo8105]

Hi,
I'm attempting to prioritize what is selected first in List box for example; I have source that has 1,2,3,4 The user will select 2,1,and 3. When the output comes out into a cell, I want it to show 2,1,3 not 1,2,3. Here is the code that I have; however, I'm getting a subscript Out of Range on

If listSelect(i) = totalSelect Then

Here is my Code at the top of the Userform:

Option Explicit 
Dim listSelect() As Integer, totalSelect As Integer, eventsEnabler As Integer
Private Sub Userform_Intialize()
' Disable DEPListBox_Change() code
eventsEnabler = 1
 
With DEPListBox
     
     ' .AddItems here
     
End With
 
ReDim listSelect(0 To DEPListBox.ListCount - 1)
totalSelect = 0
 
 ' Enable _Change() code
eventsEnabler = eventsEnabler - 1
End Sub

Then I have a Change in as well:

Private Sub DEPListBox_Change()Dim i As Integer, j As Integer, indexStart As Integer, indexEnd As Integer, stepDir As Integer
     
     ' When setting up DEPListBox, set eventsEnabler to > 0 to prevent this code from executing!
    If eventsEnabler = 0 Then
         
         ' Start by assuming we'll search for new selections top-to-bottom
        indexStart = 0
        indexEnd = DEPListBox.ListCount - 1
         
         '       This block determines direction of additional selections (up or down)
        For i = 0 To DEPListBox.ListCount - 1
             ' If we've hit the previous last selection, we already know the answer (top-to-bottom)
            If listSelect(i) = totalSelect Then Exit For
             ' If we hit a new selection before finding the previous last selection,
             ' then we'll change the search for new selections to be bottom-to-top
            If listSelect(i) = 0 And DEPListBox.Selected(i) Then
                indexStart = indexEnd
                indexEnd = 0
                Exit For
            End If
        Next i
         
        stepDir = Sgn(indexEnd - indexStart)
        If stepDir = 0 Then stepDir = 1
         
         '       Update selection list in listSelect()
        For i = indexStart To indexEnd Step stepDir
            If DEPListBox.Selected(i) = True Then
                 '               Newly selected item: place selection number in listSelect() and update totalSelect
                If listSelect(i) = 0 Then
                    listSelect(i) = totalSelect + 1
                    totalSelect = totalSelect + 1
                End If
            Else
                 '               Deselected item: remove its selection number, and update all others to compensate.
                If listSelect(i) > 0 Then
                    For j = 0 To DEPListBox.ListCount - 1
                        If listSelect(j) > listSelect(i) Then listSelect(j) = listSelect(j) - 1
                    Next j
                    listSelect(i) = 0
                    totalSelect = totalSelect - 1
                End If
            End If
        Next i
         
         ' At this point, totalSelect and listSelect() are updated for you to act upon.
        
    End If
End Sub

 

[mdo8105]

That sounds a heck of a lot easier. I've never set up code to react to double click how would I do that?

 

[mdo8105]

Hi Norie,

So I took the concept you were saying about simplifying the code and just moving from one listbox to another. I cannot figure out how to do the double click but I was able to make a piece of the process work by having a command button move the items:
Here is my code:

Private Sub cmdright_Click()

    Dim i As Integer
    Dim dictItems As Object
    Set dictItems = CreateObject("Scripting.Dictionary")


    For i = 0 To MDepList.ListCount - 1


        dictItems.Add MDepListt.list(i), vbNullString


    Next


    For i = 0 To DEPListBox.ListCount - 1
        If DEPListBox.Selected(i) = True And Not dictItems.Exists(DEPListBox.list(i)) Then


            MDepList.AddItem DEPListBox.list(i)


        End If
    Next


End Sub

Is there a way to prioritize what was chosen first and put that at the top of the list?

 

[Norie]

If you are using a MultiSelect listbox it's not going to be easy to transfer things in order.

Why not try making both the listboxes single select and then trying this.

Private Sub DEPListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim idx As Long

    idx = DEPListBox.ListIndex
    
    If idx <> -1 Then
        ' move double clicked item from DEPListBox to MDepList
        MDepList.AddItem DEPListBox.List(idx)
        DEPListBox.RemoveItem idx
    End If
    
End Sub

Private Sub MDepList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim idx As Long

    idx = MDepList.ListIndex
    
    If idx <> -1 Then
        ' move double clicked item from MDEPList to DepListBox
        DEPListBox.AddItem MDepList.List(idx)
        MDepList.RemoveItem idx
    End If
    
End Sub

 

[mdo8105]

Thank you so much, that definitely did it. Prior to using another Listbox I was sending my output from the first listbox with this code:

 For i = 0 To MDepList.ListCount - 1            If MDepList.Selected(i) Then     'If selected is True
                strTemp = strTemp & MDepList.list(i) & vbLf      'Edit ", " to required separators
            End If
        Next i
        
        If Len(strTemp) > 2 Then    'The variable will always be greater than 2 if any selections in the listbox
            strTemp = Left(strTemp, Len(strTemp) - 1) 'remove last comma and space (Edit 2 to length of separators)
        End If
        
ThisWorkbook.Worksheets("TST_SHEET").Cells(dcc + 1, 10).Value = strTemp

However, now nothing is outputting now.

 

[Norie]

Now you are using two listboxes then the second listbox should contain only the items you want to send to the sheet, so there's no need to check if they are selected.

Try this.

For i = 0 To MDepList.ListCount - 1           
    strTemp = strTemp & MDepList.list(i) & vbLf      'Edit ", " to required separators
Next i
        
If Len(strTemp) > 2 Then    'The variable will always be greater than 2 if any selections in the listbox
    strTemp = Left(strTemp, Len(strTemp) - 1) 'remove last comma and space (Edit 2 to length of separators)
End If
        
ThisWorkbook.Worksheets("TST_SHEET").Cells(dcc + 1, 10).Value = strTemp

PS Remember to change MDepList to the listbox that contains the items the user has selected.

 

[mdo8105]

That make sense. The reason I was using the above code was to format my output in Char(10) format, since there will be multiple values in one cell. Is there a better way to do that? This is where I am outputting my results

[COLOR=#333333]ThisWorkbook.Worksheets("TST_SHEET").Cells(dcc + 1, 10).Value = strTemp[/COLOR]

 

[Norie]

You could try this.

Dim arrItems As Variant

    With MDepList
        arrItems = Application.Transpose(MDepList.List)
        ThisWorkbook.Worksheets("TST_SHEET").Cells(dcc + 1, 10).Value = Join(arrItems, vbLf)
    End With

 

[mdo8105]

Hi Norie,

It's giving me a Type mismatch error on:

arrItems = Application.Transpose (MDepList.list)

arrItems: Value = Empty, Type = Variant/Empty
Application.Transpose(MDepList.List): Value = <Type Mismatch>, Type = Variant/Integer

 

[mdo8105]

Hi Norie,

I figured it out, you were absolutely right on not checking if they are selected, that is what was causing my code to fail. Here is what I used to pull the results from the second listbox your recommended

For i = 0 To Me.MDepList.ListCount - 1            If Not Me.MDepList.Selected(i) = True Then   'If selected is True
                strTemp = strTemp & Me.MDepList.list(i) & vbLf      'Edit ", " to required separators
            End If
        Next i
        
        If Len(strTemp) > 2 Then    'The variable will always be greater than 2 if any selections in the listbox
            strTemp = Left(strTemp, Len(strTemp) - 1) 'remove last comma and space (Edit 2 to length of separators)
        End If
        
ThisWorkbook.Worksheets("TST_SHEET").Cells(dcc + 1, 10).Value = strTemp

Thank you again for all your help.