VBA Userform Disappears Randomly During Code Excecution

[jtrombley24]

Hi all,

I cannot figure out why my userform disappears randomly after the code runs. I'm basically entering a number into the "Process Order" textbox and requesting data from an (Access) database using ADO. So the code can take a few seconds to run. Now and then I get the "Not Responding" notification, but it still pulls the data.

When I'm connected to my 'dock' at work and use my regular monitor, the form never disappears. On my laptop its a common occurrence. If I press "Alt-Tab" to lose focus on Excel and then "Alt-Tab" again to bring it back into focus, the userform magically reappears! What's the deal!!??

The button click event (to pull the data from the database):

Private Sub btnGetLotData_Click()

If checkForNewComments = True Then
    Dim willLoseNewComments As String
    willLoseNewComments = MsgBox("Comments were added for the current lot.  Unsubmitted comments will be permanently lost." & Chr(10) & Chr(10) & "Continue?", vbQuestion + vbYesNo, "Unsaved Comments")
    
    If willLoseNewComments = vbNo Then
        txtProcessOrder.SetFocus
        txtProcessOrder = ""
        Exit Sub
    End If
End If

Dim processOrder As String
    processOrder = txtProcessOrder.Text

' check for blank textbox
If processOrder = "" Then
    MsgBox "Process Order textbox cannot be blank.", vbInformation + vbOKOnly, "Enter a Process Order"
    txtProcessOrder.SetFocus
    txtProcessOrder.SelStart = 0
    txtProcessOrder.SelLength = Len(txtProcessOrder)
    Exit Sub
End If

lblStatus.Caption = "Status: Retrieving lot data"

Application.Wait (Now + TimeValue("0:00:01"))

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

' SQL statement
Dim mySQL As String
    mySQL = "SELECT * FROM MIDEX_V_PROCESS_ORDER_DETAILS_Query WHERE FG_Batch = '" & processOrder & "'"

' pass the variables cn, rs and mySQL 
DatabaseConnections.OpenDatabaseConnection cn, rs, mySQL



' This section is to set up data values from the
' database and place them in textboxes so that the
' information can be updated.
'
' Use the open recordset, which is set to BOF and move
' it to the first record (it's the only record since the SQL
' statement is only requesting one). Then assign values to
' each textbox as it correlates to the spreadsheet and database.

' if the recordset beginning or end of file is true, it means the lot couldn't be found
' and a blank recordset was returned.  throw an exception and exit the subroutine
If rs.BOF = True Or rs.EOF = True Then
    MsgBox "Lot not found", vbInformation + vbOKOnly, "Not Found!"
    txtProcessOrder.SetFocus ' cursor back to the textbox and highlights the contents for easy re-write
    txtProcessOrder.SelStart = 0
    txtProcessOrder.SelLength = Len(txtProcessOrder)
    Exit Sub ' end the procedure
Else
    rs.MoveFirst
End If

' |TextBox Name|    |Database Field Name|

txtData1.Value = rs.Fields("FG_Batch").Value
txtData2.Value = rs.Fields("MATERIAL_NUMBER").Value
txtData3.Value = rs.Fields("COMPONENT_BATCH").Value
txtData4.Value = rs.Fields("COMPONENT_MATERIAL_NUMBER").Value
txtData5.Value = rs.Fields("MATERIAL_DESC").Value
txtData6.Value = rs.Fields("Market").Value
txtData7.Value = rs.Fields("SCHED_START_DATE").Value
txtData8.Value = rs.Fields("Date_Packaged").Value
txtData9.Value = rs.Fields("Ship_B248").Value
txtData10.Value = rs.Fields("Sent_To_Irradiation").Value
txtData11.Value = rs.Fields("Return_From_Irradiation").Value
txtData12.Value = rs.Fields("Batch_Record_Received").Value
txtData13.Value = rs.Fields("SFG_BRR_Complete").Value
txtData14.Value = rs.Fields("FG_BRR_Complete").Value
txtData15.Value = rs.Fields("LIMS_Receipt").Value
txtData16.Value = rs.Fields("Sterility_Start").Value
txtData17.Value = rs.Fields("Sterility_End").Value
txtData18.Value = rs.Fields("HMWI_Complete").Value
txtData19.Value = rs.Fields("Retains_Logged_Approved").Value
txtData20.Value = rs.Fields("Hold").Value
txtData21.Value = rs.Fields("QA_Release").Value
txtData22.Value = rs.Fields("Q_Shippable").Value
txtData23.Value = rs.Fields("Deployment_List").Value
txtData24.Value = rs.Fields("Ship").Value
txtData25.Value = rs.Fields("Comments").Value

' close connections and release memory
rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing


' remove the process order from the process order textbox
txtProcessOrder.Text = ""

' reset the new comment variable
checkForNewComments = False

With txtData25
    .Locked = True
    .BackColor = &H80000003
End With

lblStatus.Caption = "Status: Ready for editing"

' place the cursor into the first textbox
txtData8.SetFocus

End Sub

Other relevant code:

Private Sub UserForm_Initialize()

' global variable
checkForNewComments = False

' This sub sets the combobox on the data entry form (frmMainDataEntry)
' which fills it with TRUE or FALSE for the user to select.
Dim trueFalse As Variant
Dim i As Integer

trueFalse = Array("TRUE", "FALSE")

For i = LBound(trueFalse) To UBound(trueFalse)
    Me.txtData20.AddItem trueFalse(i)
Next i

End Sub

The database connection code:

Public Sub OpenDatabaseConnection(cn As ADODB.Connection, rs As ADODB.Recordset, mySQL As String)

Dim filePath As String

filePath = Sheet7.Range("B1").Value ' from the data tab on the main spreadsheet.

Set cn = New ADODB.Connection ' new instance of the connection
With cn
    .Provider = "MICROSOFT.ACE.OLEDB.12.0"
    .Open filePath
    .CursorLocation = adUseClient
End With

Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseServer
    
rs.Open Source:=mySQL, ActiveConnection:=cn, CursorType:=adUseClient, LockType:=adLockOptimistic, Options:=adCmdText

End Sub

 

[jtrombley24]

Sorry, not sure why the image won't load!

 

[MeleaB]

Try adding the following two lines immediately before End Sub:

Application.Visible = False
Application.Visible = True

 

[mole999]

Sorry, not sure why the image won't load!

Its on your desktop, not on the accessible web

 

[mole999]

Have a look at Modal for your form