excelvbalistboxuserform

VBA: ListBox Change event firing twice


I have a User Form in Excel in which questions are indexed in a Listbox control. Clicking on an item in the Listbox calls a Change event which populates other controls' values according to which item has been selected.

The user may change values within the text boxes. Upon changing them, a "Saved" flag gets set to False for that question. The user may then save the question into memory; or navigate away from the question.

If the user navigates away without saving (by means of clicking a different item in the Listbox), I want to present them with a warning - giving the option to either abandon their unsaved changes; or to remain with the current selection, and revert the Listbox selection which they just clicked.

If "Abandon changes" is selected, it works fine. However it runs into trouble when I try to revert the Listbox selection. I use an "EventsOn" Boolean to handle when the Change procedure should proceed, to avoid it calling itself. This seems to work, at the correct point in the code. However after EventsOn is reinstated, and after Exit Sub, it seems that the Change event is called again.

I do not know why the event is firing again. This results in the user being presented with the option a second time.

A lot of the following code has been stripped out because it relates to details of other form controls; loading/saving data from a database; and handling classes and dictionaries. However I have retained the relevant logic of the form controls:

Option Explicit
Dim NumberOfQuestions As Long
Dim EventsOn As Boolean
Dim SelectedListIndex As Long, CurrentQuestion As Long, QuestionSaved As Variant

Private Sub UserForm_Initialize()
    ' Stripped out lots of code here. Basically opens a recordset and loads values
    ReDim QuestionSaved(1 To NumberOfQuestions) As Boolean
    '
    For X = 1 To NumberOfQuestions
        lbox_QuestionList.AddItem "Question " & X ' Populate the listbox with items
        QuestionSaved(X) = True ' Flag the initial state as saved, for each question
        If Not X = rst.RecordCount Then rst.MoveNext
    Next X
    '
    ' Select the first question by default. Note that the Listbox ListIndex starts at 0, whereas the questions start at 1
    SelectedListIndex = 0
    CurrentQuestion = 1
    EventsOn = True
    lbox_QuestionList.ListIndex = SelectedListIndex
End Sub

Private Sub lbox_QuestionList_Change()
    ' Ensure this event does NOT keep firing in a loop, when changed programmatically
    If Not EventsOn Then Exit Sub
    '
    If Not QuestionSaved(CurrentQuestion) Then
        If MsgBox(Prompt:="Abandon changes to current question?", Title:="Current question not saved", Buttons:=vbYesNo + vbDefaultButton2) = vbYes Then
            ' Abandon changes = Yes
            ' Mark as saved
            QuestionSaved(CurrentQuestion) = True
            ' Then proceed to change as normal
            ' (If the user comes back to this question, it will be re-loaded from memory in its original form)
            ' This works okay
        Else
            ' Abandon changes = No
            EventsOn = False ' So this sub is not called again
            ' REVERT the ListBox selection. Do this by recalling the current question number, and applying it to the ListIndex
            SelectedListIndex = CurrentQuestion - 1 ' Remember that the index will be minus 1, due to indexing starting at 0
            lbox_QuestionList.ListIndex = SelectedListIndex
            EventsOn = True
            Exit Sub ' This should be the end of it. But somehow, it's not...
        End If
    End If
    ' Proceed with loading a new question according to the new selected ListIndex
    SelectedListIndex = lbox_QuestionList.ListIndex ' Recognise the current selection
    ' ListIndex starts at zero, so we need to add 1
    CurrentQuestion = SelectedListIndex + 1
    ShowQuestion CurrentQuestion
End Sub

Private Sub ShowQuestion(QuestionNumber As Long)
    ' Stripped out code for brevity. Basically loads details from a dictionary of classes, and populates into textboxes
End Sub

Private Sub cb_Save_Click()
    ' Stipped out code. Takes values of current text boxes and saves them into a class in a dictionary
    ' Mark the current question as saved:
    QuestionSaved(CurrentQuestion) = True
End Sub

''''''''''' Event handlers ''''''''''''''
Private Sub tb_Question_Change()
    DoChange
End Sub
' Several other form controls have similar events: all calling "DoChange" as below

Private Sub DoChange()
    If Not EventsOn Then Exit Sub
    QuestionSaved(CurrentQuestion) = False ' Flag the current question as NOT saved, if any changes are made to form values
End Sub

Naturally, I have searched for this problem - but there are no answers so far which have assisted me:

The logic of my code seems sound. The mystery is why the Change event is being called a second time, even after Exit Sub.


Solution

  • (curses to OP for getting this problem in my brain!)

    In my testing, I used the following UserForm:

    enter image description here

    The code below uses the ListBox1_AfterUpdate event, and I believe it may work for you.

    Option Explicit
    
    Private Const TOTAL_QUESTIONS As Long = 3
    Private qSaved As Variant
    Private selectedDuringTextboxChange As Long
    Private eventsInProgress As Long
    
    Private Sub ListBox1_AfterUpdate()
        Debug.Print "listbox clicked, item " & (ListItemSelected() + 1) & " selected"
        If eventsInProgress > 0 Then
            Debug.Print "   ... event in progress, exiting"
            eventsInProgress = eventsInProgress - 1
            Exit Sub
        End If
    
        If Not qSaved(selectedDuringTextboxChange) Then
            Dim answer As VbMsgBoxResult
            answer = MsgBox("Abandon changes?", vbYesNo + vbDefaultButton2)
            If answer = vbYes Then
                Debug.Print "yes, abandon the changes"
                qSaved(selectedDuringTextboxChange) = True
            Else
                Debug.Print "nope, keep the changes"
                '--- return to the previously selected list item
                eventsInProgress = eventsInProgress + 1
                UnselectAll
                ListBox1.Selected(selectedDuringTextboxChange - 1) = True
                ListBox1.ListIndex = selectedDuringTextboxChange - 1
            End If
        End If
    End Sub
    
    Private Sub QuitButton_Click()
        Me.Hide
    End Sub
    
    Private Sub SaveButton_Click()
        qSaved(ListBox1.ListIndex + 1) = True
    End Sub
    
    Private Sub TextBox1_Change()
        selectedDuringTextboxChange = ListBox1.ListIndex + 1
        qSaved(selectedDuringTextboxChange) = False
        Debug.Print "changed text for question " & selectedDuringTextboxChange
    End Sub
    
    Private Sub UserForm_Initialize()
        ReDim qSaved(1 To TOTAL_QUESTIONS)
    
        selectedDuringTextboxChange = 1
        With ListBox1
            Dim i As Long
            For i = 1 To TOTAL_QUESTIONS
                .AddItem "Question " & i
                qSaved(i) = True
            Next i
            .Selected(0) = True
        End With
        eventsInProgress = False
    End Sub
    
    Private Sub UnselectAll()
        eventsInProgress = eventsInProgress + 1
        With ListBox1
            Dim i As Long
            For i = 0 To .ListCount - 1
                .Selected(i) = False
            Next i
        End With
        eventsInProgress = eventsInProgress - 1
    End Sub
    
    Private Function ListItemSelected() As Long
        ListItemSelected = -1
        With ListBox1
            Dim i As Long
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    ListItemSelected = i
                End If
            Next i
        End With
    End Function
    
    Private Sub WhichListItem_Click()
        With ListBox1
            Dim i As Long
            For i = 0 To .ListCount - 1
                Debug.Print "listbox item(" & i & ") = " & .Selected(i)
            Next i
        End With
        Debug.Print "eventsInProgress = " & eventsInProgress
    End Sub