VBA Combobox 28 error when selecting item from the list-CodePudding

I am trying to write a specific search (that will separate search results for cities and countries) with the use of Excel's ComboBox object.

When I am using keyboard buttons, then everything is fine and search works perfectly.

However, when I try to select an item from the drop-down list with the use of mouse button, then I am getting 28-error "Out of stack space".

The debugger is looping for an unknown reason and finally stops at

Set destination_short_rng = w_search.Range("Destination_short")

line of ComboBoxDestinations_Change subroutine provided below.

I would be very grateful for any hint on how to prevent this error from happening.

Private destination_search_rng As Range
Private destination_short_rng As Range
Private destination_search_col As New Collection

Private Sub ComboBoxDestinations_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
    Set w_search = Sheets("4c.Travel Costs (Search)")
        
    Set destination_short_rng = w_search.Range("Destination_short")
    
    IsArrowTopDown = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown) Or (KeyCode = vbKeyLButton)
    If KeyCode = vbKeyEscape Then UserFormSearchDest.ComboBoxDestinations.list = destination_short_rng.Value

End Sub

Private Sub InitializeDestinationSearchCollection()
    Dim num_rows As Integer
    Dim i As Integer
    num_rows = destination_short_rng.Rows.Count
    Set destination_search_col = Nothing
    For i = 1 To num_rows
        destination_search_col.Add LCase(destination_search_rng.Rows(i).Value)
    Next i
End Sub

Private Function SplitText(Text As String, separator As String) As Variant
    Dim my_array() As String
    Dim i As Integer
    
    my_array = Split(Text, separator)
    For i = LBound(my_array, 1) To UBound(my_array, 1)
        my_array(i) = LTrim(my_array(i))
    Next i
    SplitText = my_array
End Function

Private Function FoundDestination(destinations As Variant, entered_txt As String) As Boolean
    Dim entered_txt_len As Integer
    Dim i As Integer
    entered_txt_len = Len(entered_txt)
    
    FoundDestination = False
    
    For i = LBound(destinations, 1) To UBound(destinations, 1)
        If left(destinations(i), entered_txt_len) = entered_txt Then
            FoundDestination = True
            Exit For
        End If
    Next i
End Function

Private Function LeftDestination(searched_dest As String, entered_txt As String) As Variant
    Dim my_array(1 To 2) As Boolean
    Dim destinations() As String
    Dim cities() As String
    Dim countries() As String
    destinations = SplitText(searched_dest, ",")
    cities = SplitText(destinations(0), "/")
    countries = SplitText(destinations(1), "/")
    my_array(1) = FoundDestination(cities, entered_txt)
    my_array(2) = FoundDestination(countries, entered_txt)
    LeftDestination = my_array
End Function

Private Sub printCollection(txt As String, col As Collection, list As Variant)
    Dim i As Integer
    
    Debug.Print "Entered txt:", txt
    For i = 1 To Application.WorksheetFunction.Min(5, col.Count)
        Debug.Print "List item:", list(i - 1, 0)
        Debug.Print "Collection item:", col.Item(i)
    Next i
End Sub

Private Sub ComboBoxDestinations_Change()

    Dim i As Integer

    Dim txt As String
    Dim entered_txt_len As Integer
    Dim entered_txt As String
    Dim searched_dest As String
    Dim left_cities As Boolean
    Dim left_countries As Boolean

    
    Set w_search = Sheets("4c.Travel Costs (Search)")

    Set destination_short_rng = w_search.Range("Destination_short")
    
    InitializeDestinationSearchCollection

    If Not IsArrowTopDown Then
        With UserFormSearchDest.ComboBoxDestinations
            .list = destination_short_rng.Value
            entered_txt = LCase(.Text)
            If Len(entered_txt) > 0 Then
                
                For i = .ListCount - 1 To 0 Step -1
                    searched_dest = destination_search_col.Item(i   1)

                    left_cities = LeftDestination(searched_dest, entered_txt)(1)
                    left_countries = LeftDestination(searched_dest, entered_txt)(2)
                    
                    If Not (left_cities) And Not (left_countries) Then
                        .RemoveItem i
                        destination_search_col.Remove (i   1)
                    End If
                Next i

                Dim last_left_ind As Integer
                Dim is_last_ind_found As Boolean
                is_last_ind_found = False
                For i = .ListCount - 1 To 0 Step -1

                    searched_dest = destination_search_col.Item(i   1)

                    left_cities = LeftDestination(searched_dest, entered_txt)(1)
                    left_countries = LeftDestination(searched_dest, entered_txt)(2)

                    If left_cities And Not (is_last_ind_found) Then
                        is_last_ind_found = True
                        last_left_ind = i
                    End If

                    If left_countries And Not (left_cities) And is_last_ind_found Then
                        .AddItem pvargItem:=.list(i), pvargIndex:=last_left_ind   1
                        .RemoveItem i
                        destination_search_col.Add Item:=searched_dest, After:=last_left_ind   1
                        destination_search_col.Remove (i   1)
                        last_left_ind = last_left_ind - 1
                    End If
                Next i

                If .ListCount = 0 Then
                    .AddItem "No Results"
                End If
                .DropDown
                .ListRows = Application.WorksheetFunction.Min(ListRowsMax, .ListCount)
            End If
        End With
    End If
End Sub

CodePudding user response：

So as already written in the comments, you problem is that the change event routine is triggering itself recursively.

On a user form, there is no built-in mechanism to prevent this, but it's rather easy to do this by your own:

Declare a Variable (I prefer static variables as they stay local, but you can declare it also as global) and check and set it so that the routine is left immediately if it is called recursively.

Private Sub ComboBoxDestinations_Change()
    Static changeRunning As Boolean
    If changeRunning Then Exit Sub

    ... do your magic here...
    changeRunning  = False
End Sub

CodePudding user response：

Finally, I managed to deal with the problem by putting the IsMouseDown and IsEsc variables.

Private Sub ComboBoxDestinations_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    IsMouseDown = (Button = vbKeyLButton) Or (Button = vbKeyRButton) Or (Button = vbKeyMButton)
End Sub
Private Sub ComboBoxDestinations_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Set w_search = Sheets("4c.Travel Costs (Search)")
        
    Set destination_short_rng = w_search.Range("Destination_short")
    IsMouseDown = False
    IsArrowTopDown = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    IsEsc = KeyCode = vbKeyEscape
    If IsEsc Then
        UserFormSearchDest.ComboBoxDestinations.Clear
        UserFormSearchDest.ComboBoxDestinations.list = destination_short_rng.Value
    End If
End Sub

and in the ComboBoxDestinations_Change subroutine I wrote the following logic:

If Not IsArrowTopDown And Not IsMouseDown And Not IsEsc Then

Private Sub ComboBoxDestinations_Change()
    On Error GoTo Err
    Dim i As Integer

    Dim txt As String
    Dim entered_txt_len As Integer
    Dim entered_txt As String
    Dim searched_dest As String
    Dim left_cities As Boolean
    Dim left_countries As Boolean

    Set w_search = Sheets("4c.Travel Costs (Search)")

    Set destination_short_rng = w_search.Range("Destination_short")


    InitializeDestinationSearchCollection

    If Not IsArrowTopDown And Not IsMouseDown And Not IsEsc Then
        With UserFormSearchDest.ComboBoxDestinations

However, in rare cases (e.g. when the user enters additional text and clicks backspace) the inifinite loop may happen. This is why, I wrote On Error GoTo Err statement so that the event is stopped in this case.

All in all the search is working now.