VBA ActiveX ComboBox causing excel to crash

Question

I have a table within a worksheet that is designed to help Career Managers plot the future roles that employees will hold. It has columns to record each employee’s current position details and the start and end date of that position + the details and start and end dates of up to three subsequent future positions. There is a ComboBox called CmboPERS at the top of the worksheet, which allows the user to select an employee from the table. The user can then click a command button called "Open Form" to open a UserForm that populates with the employee's details and allows the user to create a plan for the employee's future positions.

The user can enter future position plans within this form that will then be added to the table in the worksheet once the update record button is clicked.

To select a position to add to the employee's career plan the user clicks the ‘Select’ button. This opens a sub UserForm to help them find the position within the organization through a series of dependent Comboboxes. The ComboBoxes within this sub UserForm are populated from a different table on a separate worksheet within the workbook.

This all works perfectly for the first employee selected. CmboPERS works, and both user forms run without issue and the employee's career plans are updated in the relevant columns within the table.

However, when the user tries to interact with CmboPERS again to select another employee, excel crashes while trying to run the ComboBox Event for CmboPERS. The event (e.g. dropbuttonclick) initiates, and through the debugger I have been able to confirm that it seems to run through the code, but when it hits the end sub line the programme just crashes.

After a bunch of testing I have determined that this does not occur if the user does not interact with the comboboxes in the sub userform. i.e. the user can amend the start and end dates within the Employee user form and then click update record and will be able to then interact with CmboPERS to select another employee with no issue. It is something about interacting with the cmboboxes in the sub user form that is preventing CmboPERS from working.

The code for CmboPERS is

Option Explicit
Dim Dict As Object
Dim pList As Variant
Private IsChanged As Boolean
 
Private Sub CmboPERS_DropButtonClick()
 
    pList = ThisWorkbook.Sheets("Posting plot").ListObjects("PERS").ListColumns("PER").DataBodyRange.Value
    Set Dict = CreateObject("scripting.dictionary")
    Dict.CompareMode = vbTextCompare
    Dim i As Long
 
    For i = LBound(pList) To UBound(pList)
        If Len(pList(i, 1)) > 7 Then
        Dict(pList(i, 1)) = Empty
        End If
    Next
        CmboPERS.List = Dict.Keys
        Dict.RemoveAll
        CmboPERS.ListRows = Application.WorksheetFunction.Min(6, CmboPERS.ListCount)
End Sub
  
Private Sub CmboPERS_Change()
 
    Dim i As Long
    Me.CmboPERS.ListRows = Application.WorksheetFunction.Min(6, Me.CmboPERS.ListCount)
 
    If Not IsChanged Then
        With Me.CmboPERS
            If .Value <> "" Then
                .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
                .DropDown
                If Len(.Text) Then
                    For i = .ListCount - 1 To 0 Step -1
                        If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then
                            .RemoveItem i
                        End If
                    Next
 
                End If
            End If
        End With
 
    End If
 
End Sub

'code to manage the user typing text into CmboPERS
 
Private Sub CmboPERS_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 
    IsChanged = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If (KeyCode = vbKeyReturn Or KeyCode = vbKeyBack) Then
        Dim i As Long
 
        For i = LBound(pList) To UBound(pList)
            If Len(pList(i, 1)) > 7 Then
                Dict(pList(i, 1)) = Empty
            End If
        Next
        CmboPERS.List = Dict.Keys
 
        Dict.RemoveAll
    End If
 
End Sub

Parts of the code for the Sub User Form "SelPost" are below. Note that just interacting with the first ComboBox - "ComboBox1" and then clicking the cancel button on the form causes CmboPERS to stop functioning and excel to crash.

Option Explicit
Dim kList As Variant
Dim Post As Variant
Private IsArrow As Boolean
Dim d As Object

Private Sub CmdBCancel_Click()
   d.RemoveAll
   ComboBox1.Clear
   ComboBox2.Clear
   ComboBox3.Clear
   ComboBox4.Clear
   ComboBox5.Clear
   ComboBox6.Clear
   Unload SelPost
End Sub

Private Sub UserForm_Activate()
   Dim WS As Worksheet
   Set WS = ThisWorkbook.Sheets("ALL POSN")
   Dim Tbl As ListObject
   Set Tbl = WS.ListObjects("ALLPOSNS")
   kList = Tbl.DataBodyRange.Value
   Set d = CreateObject("scripting.dictionary")
   
   d.CompareMode = vbTextCompare

   Dim i As Long

   For i = LBound(kList) To UBound(kList)
      d(kList(i, 8)) = Empty
   Next

   ComboBox1.List = d.Keys
   d.RemoveAll
End Sub

Private Sub ComboBox1_Change()

   Dim i As Long

   If Not IsArrow Then
      With ComboBox1
        .ListRows = Application.WorksheetFunction.Min(4, .ListCount)
        .DropDown
        If Len(.Text) Then
          For i = .ListCount - 1 To 0 Step -1
            If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
          Next
          .DropDown
        End If
     End With
   End If

End Sub

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)

   If (KeyCode = vbKeyReturn Or KeyCode = vbKeyBack) Then
      Dim i As Long
      For i = LBound(kList) To UBound(kList)
         d(kList(i, 8)) = Empty
      Next
      ComboBox1.List = d.Keys
      If Not ComboBox1.ListIndex = -1 Then
          Frame2.Visible = True
      End If
      d.RemoveAll
    End If
End Sub

VBA ActiveX ComboBox causing excel to crash

Answers (1)

Related Questions