Lag in Listboxes updating

[downhilljon]

Hi there,

In my database I have this problem occurring in several of my forms. The issue is that I perform an operation in one form, which then runs a query to get the desired results, opens a new form with a listbox, which is supposed to display the query results.

My problem is that once the form opens, the results do not display until either F9 has been pressed, or a manual refresh button (using the .requery method) has been pushed - usually 3 to 4 times.

I have tried several methods in the code to bypass this problem - opening, closing, then re-opening the form, running the .requery or .refresh methods upto 6 times in a loop, changing the focus to a different form then back again - nothing works! Any suggestions???

Here is the code I am using (sorry it's quite lengthy):

Private Sub cmdAdd_To_Build_Click()
Dim intSelection As Integer, intBike As Integer
Dim rst As New ADODB.Recordset, cn As String
Dim msgMessage As Variant, strTable As String, strField As String
Dim strSQL As String, varStatus As Variant

'Message box if no bike is selected
    If IsNull(Me.lstResults) Then
        msgMessage = MsgBox("Please select a bike from the list before clicking Add to Build List", vbOKOnly, "No Selection Made")
        Exit Sub
    End If

intBike = lstResults
intSelection = grpBuild
strTable = "[Bikes In Stock]"
strField = "StatusID"

'CHECK THAT BIKE IS OF AN APPROPRIATE STATUS
varStatus = DLookup("[StatusID]", "[Bikes In Stock]", "[BikeID] = " & intBike)
Select Case varStatus
    Case 2 To 4
    msgMessage = MsgBox("This bike is already waiting to be built. Please choose another bike.", vbOKOnly, "Please choose another bike")
    Exit Sub
    
    Case 5 To 7
    msgMessage = MsgBox("This bike is already built. Please choose another bike.", vbOKOnly, "Please choose another bike")
    Exit Sub
    
    Case 8
    msgMessage = MsgBox("This bike is already Sold. Please choose another bike.", vbOKOnly, "Please choose another bike")
    Exit Sub
    
    Case 9
    msgMessage = MsgBox("This bike's status is 'Ordered'. Click OK if you know this particular bike has arrived, and wish to add it to the build list. Otherwise, click Cancel and choose another bike.", vbOKCancel, "Bike 'Ordered'")
    If msgMessage = 2 Then
        Exit Sub
    End If

End Select


'CHECK THAT BIKE ID DOESN"T ALREADY EXIST IN BUILD LIST
If (DCount("[BikeID]", "[Builds]", "[BikeID] = " & intBike) > 0) Then
    msgMessage = MsgBox("This Bike is already on the Builds List", vbOKOnly, "Bike already on Builds List")
    Exit Sub
End If
            
'open recordset to change status
cn = CurrentProject.Connection

rst.Open strTable, cn, adOpenDynamic, adLockOptimistic

    Select Case intSelection
        Case 1
            'Determine which bike is selected, change status
            With rst
                .MoveFirst
                .Find ("[BikeID] = " & intBike)
                .Update strField, 2
                .Close
            End With
            
            
            'Add build to Builds table
            strSQL = "INSERT INTO Builds ( BikeID, DateRequired )" & _
                     "SELECT '" & intBike & "' AS BikeID, '" & _
                     Now & "' AS DateRequired;"
            
            CurrentDb.Execute strSQL
            
            'Open Outputs 5
            DoCmd.OpenForm ("Outputs 5 - Build List")
            Forms![Outputs 5 - Build List]![lstResults].Requery

                                    
        Case 2
            'change status
            With rst
                .MoveFirst
                .Find ("[BikeID] = " & intBike)
                .Update strField, 3
                .Close
            End With
            
            'open Inputs 5
            DoCmd.OpenForm ("Inputs 5 - Build List")
            Forms![Inputs 5 - Build List]![lstSelectedBike].Requery
            
        Case 3
            'change status
            With rst
                .MoveFirst
                .Find ("[BikeID] = " & intBike)
                .Update strField, 4
                .Close
            End With
            
            'open Inputs 5
            DoCmd.OpenForm ("Inputs 5 - Build List")
            Forms![Inputs 5 - Build List]![lstSelectedBike].Requery
    End Select
GoTo CleanUp

CleanUp:
intSelection = Empty
intBike = Empty
Set rst = Nothing
cn = Empty
Set msgMessage = Nothing
strTable = Empty
strField = Empty
strSQL = Empty
Set varStatus = Nothing


End Sub

I have tried in both the open and activate event to add the .requery or .refresh methods also.

Thanks!

 

[unclejoe]

Hi,

Any errors messages? Have you use the editor breakpoints to see what did your code went wrong?

First, in your VBA Editor, Tools – Options – In the Editor Tab, “Checked” all the frame “Code Setting” checkboxes.

Change this

Dim rst As New ADODB.Recordset, cn As String

To

Dim rst As New ADODB.Recordset
Dim cn As ADODB.Connnection

And change this

‘open recordset to change status
cn = CurrentProject.Connection

To

‘open recordset to change status
Set cn = CurrentProject.Connection

And add this line below the "Option Compare Database"

Option Explicit

Hope it will get you started somewhere.

 

[downhilljon]

Thanks a heap unclojoe, that has fixed the problem! I will now be able to fix all the problematic forms in my db.

incidentally, there were no error notices - only a lack of updating.

Thanks!