There is so much that can go wrong here. Cannot see anything specific.
I would restructure this using subroutines.

There should be an Exit Sub line after your MsgBox() line.

Have you not stepped through the code ?

Could be something is triggering an unexpected error that is not being
trapped.

Comment out your On Error line temporarily, when you will hopefully
get a more helpful message with debug opportunity.


Regards
BrianB
================================================== =======


"Chris" wrote in message ...
I am trying to load three comboboxes of varying sizes with the same loop.
The loop is based on the one that will always be largest (ID), the name is
the next largest and Company the smallest. The loop stops after passing the
last record of the company, when I think it should continue to load the
other two. The weirdest part is that the message box outside the loop does
not execute.

Am I missing something here? I hope this code is clear enough.

Sub LoadCombos()
Dim rsId As ADODB.Recordset
Dim rsName As ADODB.Recordset
Dim rsCompany As ADODB.Recordset
Dim numId As Integer
Dim numName As Integer
Dim numCompany As Integer
Dim varId As Variant
Dim varName As Variant
Dim varCompany As Variant
Dim sId As String
Dim sName As String
Dim sCompany As String
Dim sQry As String
Dim i As Long
Dim pct As Integer
On Error GoTo Load_Err
Set rsId = New ADODB.Recordset
rsId.CursorLocation = adUseClient
sQry = "SELECT CustID FROM qryCsCustDealer ORDER BY CustID"
rsId.Open sQry, cnn
Set rsName = New ADODB.Recordset
rsName.CursorLocation = adUseClient
sQry = "SELECT CustId,LName,FName FROM qryCsCustDealer WHERE Lname IS NOT
NULL ORDER BY Lname,FName"
rsName.Open sQry, cnn
Set rsCompany = New ADODB.Recordset
rsCompany.CursorLocation = adUseClient
sQry = "SELECT CustId,Company FROM qryCsCustDealer WHERE Company IS NOT
NULL ORDER BY Company"
rsCompany.Open sQry, cnn

numId = rsId.RecordCount
numName = rsName.RecordCount
numCompany = rsCompany.RecordCount
varId = rsId.GetRows(numId)
varName = rsName.GetRows(numName)
varCompany = rsCompany.GetRows(numCompany)
Call ShowProgress(True)

Do While i <= numId
ActiveWorkbook.Sheets(1).cboID.AddItem varId(0, i)
Debug.Print "==" & i & " " & varId(0, i);
If i <= numName Then
Debug.Print varName(1, i);
sName = "" & varName(1, i)
If varName(2, i) < "" Then sName = sName & ", " & varName(2, i)
sName = sName & " [" & Trim(varName(0, i)) & "]"
ActiveWorkbook.Sheets(1).cboName.AddItem sName
End If
If i <= numCompany Then
Debug.Print varCompany(1, i)
sCompany = "" & varCompany(1, i)
sCompany = sCompany & " [" & Trim(varCompany(0, i)) & "]"
ActiveWorkbook.Sheets(1).cboCompany.AddItem sCompany
End If
Application.StatusBar = i & " records loaded..."
pct = Int(i / numId * 100 + 0.5)
With ActiveWorkbook.Sheets(1)
.lblPrctWhite = Left(" ", 4 - Len(Str(pct))) & Str(pct) & "%"
.lblProgress.Width = (i / cMaxGrowers * (.imgProgress.Width - 3))
End With
i = i + 1
Loop
MsgBox ("done getrows")

Load_End:
Range("ae2").Value = numId & " " & numName & " " & numCompany
Call ShowProgress(False)
rsId.Close
rsName.Close
rsCompany.Close
Set rsId = Nothing
Set rsName = Nothing
Set rsCompany = Nothing
Load_Exit:
Application.Cursor = xlDefault
Exit Sub
Load_Err:
eTitle = "Error Loading Controls"
Select Case Err.Number
Case "3704", "3709"
ePrompt = Err.Number & " " & Err.Source & vbCrLf _
& "The connection to the database has been closed." & vbCrLf _
& "Would you like to re-establish?"
eRes = MsgBox(ePrompt, vbExclamation + vbYesNo, eTitle)
If eRes = vbYes Then
Call Connection
Resume
Else
Resume Load_Exit
End If
Case Else
ePrompt = Err.Number & " " & Err.Source & vbCrLf & Err.Description
Resume Load_End
End Select
End Sub