Trouble with Do Loop stopping before complete

[slammedtgs]

Hey everyone. I am having trouble with this VBA that I am using to select and append data to an output table. Everything is working fine until the last step. The last step appends all the data to an output table from the initial table. The intermediate steps select the data to output.

This could be done with several sub queries, but I found that to be too slow and cumbersome. The theory in this works great, but I don't know why its not completing.

Any help would be greatly appreciated. :banghead:

"AddExpenseToOutput()" is stopping about halfway through the list of criteria. Initially I thought there might be a null in the list, but it doesn't look like there is after dropping everything into Excel to manipulate.

Option Explicit

Dim rstAccount As DAO.Recordset
Dim rstAccounts As DAO.Recordset
Dim CAccounts As String
Dim Item As String
Dim AccountKey As String
Dim Expenses As String
Dim x As Integer
Dim StartTime As String
Dim EndTime As String


' - - - Find Top Accounts in each cost center
Public Function FindTopAccounts()

    StartTime = Time()
    DoCmd.SetWarnings False
    x = 0
    CAccounts = ""
    
    DoCmd.OpenQuery "Empty Account List", acViewNormal, acEdit
    DoCmd.OpenQuery "Empty Item Summary", acViewNormal, acEdit
    DoCmd.OpenQuery "Empty Output", acViewNormal, acEdit
    DoCmd.OpenQuery "0 Make Summary Data", acViewNormal, acEdit
    DoCmd.OpenQuery "01 - Make_Dept_List", acViewNormal, acEdit
    
    Set rstAccount = CurrentDb.OpenRecordset("Dept_List", dbOpenDynaset) '-- Open Dept_List Table
    rstAccount.MoveFirst '-- Select first record
    
    Do 'Run Query for each record in Table
        CAccounts = CStr(rstAccount(0))
        
         DoCmd.OpenQuery "02 - Append_top_3_accts", acViewNormal, acEdit
        
        rstAccount.MoveNext
        x = x + 1 ' --- Set Counter
    Loop While Not rstAccount.EOF '-- Exit Loop when no more records exist
      
    
    rstAccount.Close '-- Close recordset
    Set rstAccount = Nothing
End Function

' - - - Find top Items for each account
Public Function FindTopItems()

    DoCmd.SetWarnings False
    AccountKey = ""
    Set rstAccounts = CurrentDb.OpenRecordset("Account_Key", dbOpenDynaset) '-- Open Dept_List Table
    rstAccounts.MoveFirst   '-- Select first record
    
    Do  'Run Query for each record in Table
        AccountKey = CStr(rstAccounts(0))
        
         DoCmd.OpenQuery "04 - Append_Item_Summary", acViewNormal, acEdit
        
        rstAccounts.MoveNext
         x = x + 1 ' --- Set Counter
    Loop While Not rstAccounts.EOF  '-- Exit Loop when no more records exist
      
    rstAccounts.Close   '-- Close recordset
    Set rstAccounts = Nothing
End Function

'- - - Append output items to Output Table
Public Function AddExpensesToOutput()

    DoCmd.SetWarnings False
    Item = ""
    
    Set rstAccounts = CurrentDb.OpenRecordset("Item_Key", dbOpenDynaset) ' -- Open Database Table
    
    rstAccounts.MoveFirst ' -- Select first record to set variable
  
    Do   ' -- begin loop
        Item = CStr(rstAccounts(0))
        DoCmd.OpenQuery "06 - Append Output Table", acViewNormal, acEdit
        rstAccounts.MoveNext
        x = x + 1 ' --- Set Counter
    Loop While Not rstAccounts.EOF '  -- Exit Loop when Item_Key are empty
      
    rstAccounts.Close  ' -- Close recordset
    Set rstAccounts = Nothing
    DoCmd.SetWarnings True
    EndTime = Time() ' --- Get Time at end of process
    MsgBox ("Started at " & StartTime & vbCr & "Ended at " & EndTime & vbCr & x & " Updates Completed")

End Function
 
Public Function GetItemKey() As String
    GetItemKey = Item   ' --- Used in AddExpensesToOutput * Query Criteria Variable
End Function
Public Function GetAccounts() As String
    GetAccounts = CAccounts ' --- Used in FindTopAccounts * Query Criteria Variable
End Function
Public Function GetAccountKey() As String
    GetAccountKey = AccountKey  ' --- Used in FindTopItems * Query Criteria Variable
End Function

This code was re-purposed from another project I posted on the forums.

 

[Cronk]

What line is the loop stopping on?

Of course with DoCmd.SetWarnings False you don't get any error messages, so I would also comment it out until you find/fix the problem. It would be even better if you included error trapping.

 

[DavidAtWork]

can you give us more info on your query:
"06 - Append Output Table", in particular any criteria tied to the value that is being set by:
Item = CStr(rstAccounts(0)),
presumably 'Item' is a global variable and you may want to inspect the value(s) coming from CStr(rstAccounts(0))

David

 

[gemma-the-husky]

actually, i wondered about that.

Item = CStr(rstAccounts(0))

first - is rst(0) a legitimate shortcut for rst.fields(0)
second - assume it is - so what happens if it is null


---

anyway - i would do this in bits. make sure that each fragment is working correctly, and gradually bring the whole thing together. Put msgboxes in at various stages. make select variants of the append queries, and show the selected items before running the append queries.

everything you can do to make sure the whole routine is foolproof.

 

[slammedtgs]

Cronk - The loop was completing properly. Something was triggering the "Loop While Not rstAccounts.EOF"

DavidAtWork - Item is a unique key that is formed by a series fields. I think what happened was there is a null value which is trigger the loop to stop.

Gemma-The-Husky - I think you are correct. I was playing around with this and all of the intermediary steps were working and all of the gloabal keys "Items" were in the table, but the loop was stopping.

Solution: I sorted all of the key tables to move nulls to the end, this seems to be working. After a bit more testing I will just write a query to delete null values.

Thanks for the replys.