Selecting an item in a listbox deselects another item

[danners430]

Afternoon all,

I've got a listbox in a userform with MultiSelect set to 1 (fmMultiSelectMulti), and ListStyle set to 1 (fmListStyleOption).

All the entries are input programmatically, and certain options are "pre-selected" by the code prior to the user interacting with the element. In this particular case, the first two of 10 elements get selected.

I'm finding, however, that when the user selects another option in addition to the two already set, the first option seems to deselect itself. This shouldn't be happeing at all, and there's nothing in the code that would technically do this.

However:

• This does not occur every time, but almost every time
• If I add any breakpoints to the code whatsoever, this does not happen
• I've added a Msgbox at the start of each and every procedure in the userform code, and none of them appear when the issue occurs

I've added the code below...

Option Explicit

Dim suppressEvents As Boolean
Dim preSelected() As Boolean
Dim previousSelection As Integer


Private Sub cbAdd_Click()


MsgBox "cbAdd_Click"


Call groupAdd


End Sub




Private Sub groupAdd()


MsgBox "groupAdd"


Dim lastrow As Long
Dim i As Long
Dim i2 As Long
Dim selected() As Integer


lastrow = Sheet5.Cells(Sheet5.Rows.Count, "C").End(xlUp).Row


Sheet5.Cells(lastrow + 1, 3) = tbAdd.Value


ActiveWorkbook.Names("Groups").RefersToR1C1 = "='Hidden Lists'!R1C3:R" & lastrow + 1 & "C3"
ActiveWorkbook.Names("GroupsSort").RefersToR1C1 = "='Hidden Lists'!R1C3:R" & lastrow + 1 & "C4"


Sheet5.Range("GroupsSort").Sort Sheet5.Cells(1, 3)


lbGroups.RowSource = "Groups"


tbAdd.Value = ""


End Sub




Private Sub cbDelete_Click()


MsgBox "cbDelete_Click"


Dim answer As Variant


answer = MsgBox("Delete " & lbGroups.List(lbGroups.ListIndex) & "?", vbOKCancel)


If answer <> 1 Then Exit Sub


Sheet5.Range("C" & lbGroups.ListIndex + 1 & ":D" & lbGroups.ListIndex + 1).Delete xlShiftUp


lbGroups.RowSource = "Groups"


End Sub




Private Sub lbGroups_Change()


MsgBox "lbGroups_Change"


Dim i As Long


If suppressEvents = True Then Exit Sub


If IsNull(lbGroups) = True Then
    cbDelete.Enabled = False
    ListBox1.Enabled = False
Else
    
    Dim i2 As Long
    Dim i3 As Long
    
    For i = 0 To UBound(preSelected)
        i2 = i2 - (preSelected(i) = True)
        i3 = i3 - (ListBox1.selected(i) = True)
    Next i
    
    If cbDelete.Enabled = True And i2 <> i3 Then
    
        Sheet5.Cells(previousSelection + 1, 5) = ""
    
        For i = 1 To ListBox1.ListCount
    
            If ListBox1.selected(i - 1) = True Then
                Sheet5.Cells(previousSelection + 1, 5) = Sheet5.Cells(previousSelection + 1, 5) & i & ","
            End If
    
        Next i
    
    End If
    
    Call listboxPreSelect
    
    cbDelete.Enabled = True
    ListBox1.Enabled = True
    
    previousSelection = lbGroups.ListIndex
    
End If


End Sub




Private Sub tbAdd_Change()


MsgBox "tbAdd_Change"


If suppressEvents = True Then Exit Sub


If tbAdd.Value = "" Then
    cbAdd.Enabled = False
Else
    cbAdd.Enabled = True
End If


End Sub


Private Sub tbAdd_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)


MsgBox "tbAdd_KeyDown"


If KeyCode <> 13 Then Exit Sub


Call groupAdd


End Sub


Sub tbAdd_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
    MsgBox "tbAdd_MouseDown"
    
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, tbAdd.Text, X, Y, tbAdd)
    End If
End Sub


Private Sub UserForm_Activate()


MsgBox "UserForm_Activate"


Call listboxUpdate


End Sub




Private Sub listboxUpdate()


MsgBox "listboxUpdate"


Dim i As Long
Dim lastrow As Long


ListBox1.Clear


lastrow = Sheet5.Cells(Sheet5.Rows.Count, "A").End(xlUp).Row


For i = 1 To lastrow
    
    ListBox1.AddItem Sheet5.Cells(i, 1)
    ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet5.Cells(i, 2)


Next i


ReDim preSelected(0 To ListBox1.ListCount - 1)


End Sub




Private Sub listboxPreSelect()


MsgBox "listboxPreSelect"


Dim selectionVar As Variant
Dim i As Integer


suppressEvents = True


For i = 0 To ListBox1.ListCount - 1
    
    ListBox1.selected(i) = False
    preSelected(i) = False


Next i


If Sheet5.Cells(lbGroups.ListIndex + 1, 5) = "" Then


    selectionVar = Split(Sheet5.Cells(lbGroups.ListIndex + 1, 4), ",")


Else
    
    selectionVar = Split(Sheet5.Cells(lbGroups.ListIndex + 1, 5), ",")


End If


For i = 0 To UBound(selectionVar) - 1


    ListBox1.selected(CInt(selectionVar(i) - 1)) = True
    preSelected(CInt(selectionVar(i) - 1)) = True


Next i


suppressEvents = False


End Sub




Private Sub Apply()


MsgBox "Apply"


Sheet5.Cells(lbGroups.ListIndex + 1, 4) = Sheet5.Cells(lbGroups.ListIndex + 1, 5)


End Sub

 

[danners430]

Update: I've tried a number of things, and have a little more info...

• If I alter the "starting values" to deselect the first entry, it then randomly selects itself instead of deselecting itself
• Removing the programmatic population of the listbox and replacing with a RowSource doesn't work
• I've tried commenting out every single command (only about 2-3) that is capable of deselecting an entry - this doesn't work
• It never seems to occur the first time I attempt to recreate the error after altering the code in any way, always on the second and subsequent attempts
• I tried adding a Msgbox to the ListBox1_Change event, but it didn't register the deselection, only the selection which "triggered" the bug
• I tried removing two modules which make use of Windows APIs (to enable the scroll wheel and right click menu), and even after restarting this didn't solve it

I'm kinda stumped now - does anyone have any ideas??

Cheers