MultiSelect Listbox Selects First Item On Click

[JTBorton]

I have a multiselect listbox in an excel userform. Initially there are no items selected in the listbox. When the user selects an item in the list box for the first time it selects both the item the user selected AND the very first item in index 0. It only does this the very first time the user clicks in the list box. Once they uncheck the first item the issue does not reoccur until the form is re-loaded. The really frustrating thing is that it does not occur every time. One time I load excel and then load the form and the issue occurs. Then I close and restart excel, reload the form, and it does not occur. Then I close and restart excel, reload the form, and it occurs. Any idea what hidden properties would cause this?

The listbox is populated by passing the listbox object to the following function

Public Sub LoadNameList(ctlListBox As MSForms.Control, Optional IsFilter As Boolean = False, Optional CombineDepartments As Boolean = False, Optional InDepartment As Variant, Optional ActiveOnly As Boolean = False, Optional MgmtOnly As Boolean = False, Optional AnyItemFilterText As String = vbNullString)
    Dim strSQL          As String
    Dim rstRecords      As ADODB.Recordset
    Dim vntCatch()      As Variant
    Dim lngDept()       As Long
    'Dim blnDeptFilter   As Boolean
    Dim lngDeptCount    As Long
    Dim vntRecords()    As Variant
    Dim intColCount     As Integer
    Dim strColWidths    As String
    Dim lngCount        As Long
    Dim F               As Long
    Dim D               As Long
    Dim strCatch        As String
    Dim lngID           As Long
    Dim blnActive       As Boolean
    
    If Not ctlListBox Is Nothing Then
        If TypeOf ctlListBox Is MSForms.ComboBox Or TypeOf ctlListBox Is MSForms.ListBox Then
            ctlListBox.Clear
            
            If IsFilter = True Then
                ctlListBox.AddItem 0
                If CombineDepartments = True Then
                    If AnyItemFilterText = vbNullString Then
                        AnyItemFilterText = "Any User/Department"
                    End If
                    ctlListBox.List(ctlListBox.ListCount - 1, 1) = 0
                    ctlListBox.List(ctlListBox.ListCount - 1, 2) = AnyItemFilterText
                Else
                    If AnyItemFilterText = vbNullString Then
                        AnyItemFilterText = "Any User"
                    End If
                    ctlListBox.List(ctlListBox.ListCount - 1, 1) = AnyItemFilterText
                End If
            End If
            
            lngDept = ExtractIDs(Variable:=InDepartment, ForceDefault:=True, DefaultValue:=0)
            On Error Resume Next
                lngDeptCount = UBound(lngDept)
            On Error GoTo 0
            
            If CombineDepartments = True Then
                intColCount = 3
                strColWidths = "0 pt;0 pt"
            Else
                intColCount = 2
                strColWidths = "0 pt"
            End If
            
            strSQL = "SELECT [ID], [InActive], [DisplayAs], [FName], [LName] FROM [tblPeople]"
            If lngDept(1) <> 0 Then
                For F = 1 To lngDeptCount
                    If F = 1 Then
                        strSQL = Trim(strSQL) & " WHERE [Department]=" & lngDept(F)
                    Else
                        strSQL = Trim(strSQL) & " OR [Department]=" & lngDept(F)
                    End If
                Next F
            End If
            
            strSQL = Trim(strSQL) & " ORDER BY [DisplayAs];"
            Set rstRecords = OpenRecordset(strSQL)
            If RecordsetOpen(rstRecords) = True Then
                On Error Resume Next
                    rstRecords.MoveFirst
                    Do While Not rstRecords.EOF
                        lngID = 0: strCatch = vbNullString: blnActive = False
                        lngID = rstRecords("ID")
                        If lngID > 0 Then
                            blnActive = rstRecords("InActive")
                            If ActiveOnly = False Or (ActiveOnly = True And blnActive = True) Then
                                strCatch = rstRecords("DisplayAs")
                                If strCatch = vbNullString Then
                                    strCatch = rstRecords("FName") & " " & rstRecords("LName")
                                End If
                                If strCatch <> vbNullString Then
                                    ReDim vntCatch(1 To intColCount)
                                    vntCatch(1) = lngID
                                    If CombineDepartments = True Then
                                        vntCatch(2) = 1
                                        vntCatch(3) = strCatch
                                    Else
                                        vntCatch(2) = strCatch
                                    End If
                                    lngCount = lngCount + 1
                                    ReDim Preserve vntRecords(1 To lngCount)
                                    vntRecords(lngCount) = vntCatch
                                End If
                            End If
                        End If
                        rstRecords.MoveNext
                    Loop
                On Error GoTo 0
            End If
            Call KillRecordset(rstRecords)
            
            If CombineDepartments = True Then
                strSQL = "SELECT [ID], [InActive], [Department] FROM [tblDepartments] ORDER BY [Department];"
                Set rstRecords = OpenRecordset(strSQL)
                If RecordsetOpen(rstRecords) = True Then
                    On Error Resume Next
                        rstRecords.MoveFirst
                        Do While Not rstRecords.EOF
                            lngID = 0: strCatch = vbNullString: blnActive = False
                            lngID = rstRecords("ID")
                            If lngID > 0 Then
                                blnActive = rstRecords("InActive")
                                If ActiveOnly = False Or (ActiveOnly = True And blnActive = True) Then
                                    strCatch = rstRecords("Department")
                                    If strCatch <> vbNullString Then
                                        ReDim vntCatch(1 To intColCount)
                                        vntCatch(1) = lngID
                                        vntCatch(2) = 2
                                        vntCatch(3) = strCatch
                                        lngCount = lngCount + 1
                                        ReDim Preserve vntRecords(1 To lngCount)
                                        vntRecords(lngCount) = vntCatch
                                    End If
                                End If
                            End If
                            rstRecords.MoveNext
                        Loop
                    On Error GoTo 0
                End If
                Call KillRecordset(rstRecords)
            End If
        
            vntRecords = CorrectArray(vntRecords, intColCount)
            vntRecords = HeapSort(vntRecords, hpstSortAscending, False, intColCount)
            
            ctlListBox.ColumnCount = intColCount
            ctlListBox.ColumnWidths = strColWidths
            With ctlListBox
                For F = 1 To lngCount
                    .AddItem
                    For D = 1 To intColCount
                        .List(.ListCount - 1, D - 1) = vntRecords(F, D)
                    Next D
                Next F
            End With
        End If
    End If
End Sub

-Joshua
If it's not broken, it doesn't have enough parts yet.