Access List Box Double Click Event Problem

Hi All,

I have a Multi-Select listbox on a form called lstReconBillerLoads. It is important that the multi-select remains as it is.

On the control got focus and lost focus events, I have some formatting taking place but that is all.

On the double click event however, I have a routine that checks the items selected and does some processing.

The problem is, when a user clicks on one row of data, it highlights black as expected, then, if they double click that same line again, it deselects the row and prompts to select a value.

This is very frustrating as I cannot determine why this is occuring with something that seems so simple.

I have enclosed my current code for the double click event.

Can anyone help please?

Private Sub lstReconBillerLoads_DblClick(Cancel As Integer)
On Error GoTo Err_Handler
'prepare to process paid klms
'Checking to see if user selected something
Dim vFlag As String, vFrom As String, vTo As String, vSub As Long, vRoute As String

With Me.lstReconBillerLoads
    
    If .ItemsSelected.Count = 0 Then
        
        'No record found prompt
        msg = "DLD could not find any paid kilometre routes for processing." & vbCrLf & "" & vbCrLf & _
        "Please select which paid kilometre routes you wish to process from the list."
        title = "No paid kilometre routes selected"
        style = vbOKOnly + vbExclamation
        response = MsgBox(msg, style, title)
        Call Form_Load
        Exit Sub
    
    ElseIf .ItemsSelected.Count > 1 Then 'Not going ahead
    
        'more than 1 record selected prompt
        msg = "DLD detected that you have selected more than 1 paid kilometre route for processing." & vbCrLf & "" & vbCrLf & _
        "Please select ONLY 1 paid kilometre route from the list."
        title = "More than 1 paid kilometre routes selected"
        style = vbOKOnly + vbExclamation
        response = MsgBox(msg, style, title)
        Call Form_Load
        Exit Sub
        
    ElseIf .ItemsSelected.Count = 1 Then 'time to go
            
            vFlag = Me.lstReconBillerLoads.Column(9)
            
            If Not vFlag = "Y" Then
                msg = "The route you have selected is not eligable for an update of Paid KLMs." & vbCrLf & "" & vbCrLf & _
                "Please try another route that is a flagged as a new route."
                title = "Ineligable route found"
                style = vbOKOnly + vbInformation
                response = MsgBox(msg, style, title)
                Call Form_Load
                Exit Sub
            Else
                'setting edit mode to stop anything else from going on
                Me.txtEditMode.Value = 1 '
                Me.cmdCancel.SetFocus
                
                'collect from and to locations
                vFrom = Me.lstReconBillerLoads.Column(7)
                vTo = Me.lstReconBillerLoads.Column(8)
                
                'check first to add a new suburb
                msg = "You are about to update the paid KLMs for the following route:" & vbCrLf & "" & vbCrLf & _
                "From:       " & vFrom & "       To:          " & vTo & "" & vbCrLf & "" & vbCrLf & _
                "Are you sure you want to continue?"
                title = "Update paid kilometres?"
                style = vbYesNo + vbQuestion
                response = MsgBox(msg, style, title)
                    
                If response = vbYes Then
                    'prepare to
                    
                    'show the new field and ipdate lable caption
                    Me.lblNewKLMs.Visible = True
                    Me.txtNewKLMs.Visible = True
                    
                    'dispute
                    Me.optDispute.Value = 0
                    Me.lblDispute.Visible = False
                    Me.optDispute.Visible = False
                    
                    'paid
                    Me.lblPaid.Visible = False
                    Me.optPaid.Visible = False
                    Me.optPaid.Value = 0
                    
                    'lock down the others
                    Me.lstReconBillerLoads.Enabled = False
                                            
                    'prompt user
                    msg = "Please enter a new paid KLMs into the following highlighted field." & vbCrLf & "" & vbCrLf & _
                    "When you have finished, click on the update paid KLMs button to confirm."
                    title = "Enter new paid KLMs"
                    style = vbOKOnly + vbInformation
                    response = MsgBox(msg, style, title)
                    
                    'set label captcha
                    Me.lblNewKLMs.Caption = "Enter a new paid KLMs for Origin: " & vFrom & " Destination: " & vTo & ""
                    
                    'set focus
                    Me.txtNewKLMs.SetFocus
                   
                Else 'response
                    Call Form_Load
'                       Exit Sub
                End If 'response
            End If 'flag test
    End If 'selected count
End With

ErrorHandlerExit:
   Exit Sub

Err_Handler:
   If Err.Number = 0 Then
      Resume ErrorHandlerExit
   Else
    msg = "An unexpected error has been detected" & Chr(13) & _
    "Description is: " & Err.Number & ", " & Err.Description & Chr(13) & _
    "Please note the above details before contacting DLD support."
    title = "DLD support error messaging"
    style = vbOKOnly + vbInformation
    response = MsgBox(msg, style, title)
      Resume ErrorHandlerExit
   End If
End Sub

Select allOpen in new window

CF