vba not responding but still running code?

When my listbox is loading the results from the query the form will say not responding. I'll wait a few seconds (time varies but never more then a minute) and the results will then appear in the listbox and the not responding title is gone. My loops are below. I'm looking through 282,828 files from 3 different tables. I would like to get rid of the not responding error.

Code:

---

rst.Open str, cnt
    LstCnt = 1

    Do Until rst.EOF
    On Error Resume Next
        LstCnt = LstCnt + 1
        rst.MoveNext
    Loop
   
    rst.Close
    ReDim InfoArray(LstCnt, 8)
    rst.Open str, cnt
    x = 0

    'Addes data results to the array
    Do Until rst.EOF
    On Error Resume Next
        InfoArray(x, 0) = rst!JOB_NO
        InfoArray(x, 1) = rst!CUST_NAME
        InfoArray(x, 2) = rst!CUS_SITE_ADDR_1
        InfoArray(x, 3) = rst!JOB_NAME
        InfoArray(x, 4) = rst!CUST_NO
        InfoArray(x, 5) = rst!CUST_SITE
        InfoArray(x, 6) = rst!CUST_ADDR_1
        InfoArray(x, 7) = rst!CUST_ADDR_3
        x = x + 1
        rst.MoveNext
    Loop

---

It's "not responding" because the thread is busy else where.... UI updates are low priority. A couple things...

first... there's no need for this:

Code:

---

rst.Open str, cnt
    LstCnt = 1

    Do Until rst.EOF
    On Error Resume Next
        LstCnt = LstCnt + 1
        rst.MoveNext
    Loop
   
    rst.Close
    ReDim InfoArray(LstCnt, 8)
    rst.Open str, cnt
    x = 0

---

You're running the query twice, for no reason....

at best, you should be able to do this:

Code:

---

rst.Open str, cnt
LstCnt = rst.RecordCount

ReDim InfoArray(LstCnt, 8)
x = 0

---

at worst, this:

Code:

---

rst.Open str, cnt
rst.MoveLat
LstCnt = rst.RecordCount
Lst.MoveFirst

ReDim InfoArray(LstCnt, 8)
x = 0

---

Now, specifically regarding the not responding message... the way to handle that is with a DoEvents... BUT you don't want to just do that on every loop through....

So try something like this:

vb Code:

x = x + 1
        if (x mod 1000) = 0 then
             doEvents
        End If
        rst.MoveNext
    Loop

That will cause the DoEvents to run every 1000 rows... so it won't slow down the process too much, but at least allow the screen to be updatable, and should prevent the "Not Responding" message.

-tg