VBA Code to loop thorugh DAO recordset with pre-existing query

[tmguru]

Hi all,


I really have tried to figure this out but can't. I think Google may ban me soon!! (jk)


I am building a budget database and have a expense entry form that I want to populate some text controls with data from a pre-existing query to let the user know how much was spent in the category they chose from a combo box so far in the current month. The data pieces I want from the pre-existing query (which works fine) are: the category budget for the month and how much is remaining (or isn't). The query by itself always pulls up at least 40 records so there are plenty of rows to go through.


I have written the code below but it will not populate the controls I put an incrementing counter "i" in to see how far the do while loop gets. When I get an error the counter is at zero o it's never reaching the incrementing assignment. I know there's a hundred ways to skin a cat (can we say that anymore?) but I only need one. Any suggestions would be appreciated.

Here's the code:

Private Sub cboCategoryName_AfterUpdate()

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim errtext As String
Dim i As Integer
On Error GoTo Err_Name
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qryCurrentMonthSpend", dbOpenDynaset)
rst.MoveFirst
i = 0
Do While Not rst.EOF
If rst![Category] = Me.cboCategoryName Then
Me.[txtCategory] = rst![Category]
Me.[txtCurrentSpend] = rst![Spent]
Me.[txtCategoryBudget] = rst![Budget Amount]
Me.[txtBudgetRemaining] = rst![Budget Amount] - rst![Spent]
'we got what was needed. Now exit
Exit Do
rst.MoveNext
i = i + 1
End If
Loop
' Cleanup
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Sub
Err_Name:
MsgBox ("There was an error! " & "i Value = " & i)
End Sub

Any suggestions? Be kind, I'm still a newbie

Thanks!

-tmguru

 

[arnelgp]

You can specifically find the record you want without looping:

Set rst = dbs.OpenRecordset("select category, spent, [budget amount], [budget amount]-spent as exp1 from qryCurrentMonthSpend where category=""" & me.cboCategoryName & """", dbOpenDynaset)
If not (rst.bof and rst.eof) then
Rst.movefirst
Me.[txtCategory] = rst![Category]
Me.[txtCurrentSpend] = rst![Spent]
Me.[txtCategoryBudget] = rst![Budget Amount]
Me.[txtBudgetRemaining] = rst![exp1]
End if
Rst.close
Set rst=nothing

 

[JHB]

arnelgp gives you a good solution, but if you want to stick with you code, the look at the comments I've added.

Private Sub cboCategoryName_AfterUpdate()
  Dim dbs As DAO.Database
  Dim rst As DAO.Recordset
  Dim errtext As String
  Dim i As Integer
  [COLOR=SeaGreen]'On Error GoTo Err_Name[/COLOR] [COLOR=Red]'Comment out the errorhandler until the code runs okay, else you can't see which codeline cause the problem[/COLOR]
  
  Set dbs = CurrentDb()
  Set rst = dbs.OpenRecordset("qryCurrentMonthSpend", dbOpenDynaset)
  [COLOR=seagreen]'rst.MoveFirst[/COLOR] [COLOR=Red]'You don't need MoveFirst, it would cause an error if the query doesn't return any records[/COLOR]
  i = 0
  Do While Not rst.EOF
    If rst![Category] = Me.cboCategoryName Then
      Me.[txtCategory] = rst![Category]
      Me.[txtCurrentSpend] = rst![Spent]
      Me.[txtCategoryBudget] = rst![Budget Amount]
      Me.[txtBudgetRemaining] = rst![Budget Amount] - rst![Spent]
      'we got what was needed. Now exit
      Exit Do
    End If  [COLOR=red]'You need to have the End IF here, else you'll never move to next record if the first record isn't equal to cboCategoryName[/COLOR]
    rst.MoveNext
    i = i + 1
   [COLOR=seagreen] 'End If[/COLOR]  [COLOR=red]'Is in wrong place.[/COLOR]
  Loop
  ' Cleanup
  rst.Close
  Set rst = Nothing
  Set dbs = Nothing
  Exit Sub

Err_Name:
  MsgBox ("There was an error! " & "i Value = " & i)
End Sub

 

[MarkK]

I would definitely go with arnel's solution here, and open exactly the recordset you need, rather than open an overly broad recordset and loop thru it to find what you need. I would approach it like this....

Private Sub cboCategoryName_AfterUpdate()
    Const SQL As String = _
        "SELECT Category, Spent, BudgetAmount, BudgetAmount - Spent as BudgetRemaining " & _
        "FROM qryCurrentMonthSpend " & _
        "WHERE Category = p0 "
  
    With CurrentDb.CreateQueryDef("", SQL)  [COLOR="Green"]'here we use a temp QueryDef[/COLOR]
        .Parameters(0) = Me.cboCategoryName [COLOR="green"]'so we can paramterize the SQL[/COLOR]
        With .OpenRecordset                 [COLOR="green"]'and open the exact recordset we need[/COLOR]
            If Not .EOF Then                [COLOR="green"]'then, if there is data, we use it.[/COLOR]
                Me.txtCategory = !Category
                Me.txtCurrentSpend = !Spent
                Me.txtCategoryBudget = !BudgetAmount
                Me.txtBudgetRemaining = !BudgetRemaining
            End If
            .Close
        End With
        .Close
    End With

End Sub

...but the main thing is I would avoid the loop.
hth
Mark

 

[tmguru]

arnelgp & JHB

Thank you for your suggestions! I do like the simplicity of arnelgp's idea but I was curious why my code wasn't working so JHB I appreciate you pointing out what was wrong.

Arniegp - I tried your code but got an error 'Too few parameters' - see the attached docx.

JHB - I fixed my code per your suggestions and it ran without error ( I commented out the error handler for now) but it did not populate any of the text fields.

I believe the problem may be related to the actual content of the combo box cboCategoryName. All of my combo boxes were created by using the form wizard and dragging the fields onto the form while combo box was selected in design view. Access created the queries associated with each. In the initial creation of the data base I allowed access to split an Excel spreadsheet into various tables and it also created the relationships and queries. My frmAddExpense form has been working perfectly as it populates several tables and maintains the relationship integrity so I'm loathe to change it but I think the way Access populates the combo box from the dropdown may be preventing the code from working. I'm pretty sure the clue is in the query access created for the dropdown but I'm not knowledgeable enough yet to see it or know why.

Another clue is that if I select a category using only a dropdown choice the code does not execute (I'm assuming it does not recognize that a change or update was made. I know this because arniegp's code (at least for now) breaks out ONLY when I have started an entry by typing but does not break out if I don't type and just use the dropdown. This is consistent with when I was testing my own code before I posted my issue. Even typing the entire Category name using JHB's mods still does not populate the text fields. I have tried OnChange and OnUpdate but neither one made a difference in skipping over the code if only using the dropdown.

When the frmAddExpense form opens I use a macro to create a New Record as that is the only activity this form is used for. After the record is Saved, I also create a New Record.

I've attached a screenshot of the properties view with the row source select code for cboCategoryName combo box. I haven't changed anything on the data properties tab since Access initially created it. Hopefully this will help someone more experienced than I to see what's going on. In case the row query is too small too read in the jpg, here it is:

SELECT [ID] AS xyz_ID_xyz, [Category] AS xyz_DispExpr_xyz, [Category] FROM tblCategory ORDER BY [Category];

In case you wonder what the label inside cboCategoryName tblCategory_ID is I have no idea. It must be something access uses related the query and table tbl Category and the field ID but there is no actual table called tblCategory_ID

Thanks again for your help so far! I think we're very close

-tmguru

 

[arnelgp]

change it to this:

Set rst = dbs.OpenRecordset("select category, spent, [budget amount], [budget amount]-spent as exp1 from qryCurrentMonthSpend where category=""" & me.cboCategoryName.column(1) & """", dbOpenDynaset)
If not (rst.bof and rst.eof) then
Rst.movefirst
Me.[txtCategory] = rst![Category]
Me.[txtCurrentSpend] = rst![Spent]
Me.[txtCategoryBudget] = rst![Budget Amount]
Me.[txtBudgetRemaining] = rst![exp1]
End if
Rst.close
Set rst=nothing

 

[tmguru]

Hi arnelgp, I copied and pasted the new code and still got the same error on the same line.

-tmguru

 

[arnelgp]

Also check if qryCurrentMonthSpend query is using Form control as criteria, youll have to open that form for the code to work.

 

[tmguru]

Hi MarkK,

I just saw your reply and tried the code as a verbatim replacement for mine. I got an error similar to the one I got using arnelgp's code. See attached docx.

Thanks!

-tmguru

 

[tmguru]

Hi arnelgp,

I'm not exactly familiar with what you are asking for (do you mean a Like statement?). Here's the sql for qryCurrentMonthSpend, which is dependent on qryExpenseDetail so the sql for that is below too. What and where do you suggest I change something?

qryCurrentMonthSpend:

SELECT DISTINCTROW qryExpenseDetail.Category, Format$([qryExpenseDetail].[DatePurchased],'mmm yyyy') AS [Month/Year], Sum(qryExpenseDetail.Price) AS Spent, Max(tblCategory.Budget) AS [Budget Amt]
FROM (tblCategory INNER JOIN tblItems ON tblCategory.[ID] = tblItems.[tblCategory_ID]) INNER JOIN qryExpenseDetail ON tblItems.[ID] = qryExpenseDetail.[tblItems_ID]
WHERE (((qryExpenseDetail.DatePurchased) Between DateSerial(Year(Date()),Month(Date()),1) And DateSerial(Year(Date()),Month(Date())+1,0)))
GROUP BY qryExpenseDetail.Category, Format$([qryExpenseDetail].[DatePurchased],'mmm yyyy'), Year([qryExpenseDetail].[DatePurchased]);

qryExpenseDetail:

SELECT Table2.ID, Table2.tblItems_ID, Table2.DatePurchased, tblItems.Item, Table2.Price, tblSupplier.Supplier, tblCategory.Category
FROM (Table2 LEFT JOIN tblSupplier ON Table2.[tblSupplier_ID] = tblSupplier.[ID]) LEFT JOIN (tblItems LEFT JOIN tblCategory ON tblItems.[tblCategory_ID] = tblCategory.[ID]) ON Table2.[tblItems_ID] = tblItems.[ID]
ORDER BY Table2.DatePurchased DESC;

Thanks

-tmguru

 

[arnelgp]

Me.[txtCategory] = me.cbocategoryname.column(1)
Me.[txtCurrentSpend] = dsum("spent", "qryExpenseDetail", "category='"& me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
Me.[txtCategoryBudget] = dmax("[budget amount]", "qryExpenseDetail", "category='"& me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
Me.[txtBudgetRemaining] = [txtCategoryBudget] - [txtCurrentSpend]

 

[tmguru]

Hi arnelgp,

Unfortunately the procedure is still having the same too few parameters error. I attached a .docx with a screenshot of the error and a screenshot of the debug screen that followed, Here is the full procedure with your latest code:

Private Sub cboCategoryName_AfterUpdate()
Dim dbs As Database
Dim rst As Recordset
Dim exp1 As Currency
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("select category, spent, [budget amount], [budget amount]-spent as exp1 from qryCurrentMonthSpend where category=""" & Me.cboCategoryName.Column(1) & """", dbOpenDynaset)
If Not (rst.BOF And rst.EOF) Then
rst.MoveFirst
Me.[txtCategory] = Me.cboCategoryName.Column(1)
Me.[txtCurrentSpend] = DSum("spent", "qryExpenseDetail", "category='" & Me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
Me.[txtCategoryBudget] = DMax("[budget amount]", "qryExpenseDetail", "category='" & Me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
Me.[txtBudgetRemaining] = [txtCategoryBudget] - [txtCurrentSpend]
End If
rst.Close
Set rst = Nothing
End Sub

There is one other thing happening in the frmNewExpense form that I wasn't expecting so I thought I'd mention it to see if it is a clue. As soon as an item is entered in the cboItemName combo box, the cboCategoryName combo populates with what I assume is the last CategoryName used for that item. For example if "Batteries" is entered in the cboItemName combo box via the dropdown or typed in, the Category "Home Improvements" automatically populates in the cboCategoryName. This is a time saver but I did nothing to make that happen. Could the code / query associated with cboItemName be conflicting with the procedure in cboCategoryName. I wouldn't think so because whatever is auto-populated can be replaced with something else typed in. I just wanted to mention it.

I really do appreciate your time in helping to try and solve this!

-tmguru

 

[Galaxiom]

Private Sub cboCategoryName_AfterUpdate()
Dim dbs As Database
Dim rst As Recordset
Dim exp1 As Currency
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("select category, spent, [budget amount], [budget amount]-spent as exp1 from qryCurrentMonthSpend where category=""" & Me.cboCategoryName.Column(1) & """", dbOpenDynaset)
If Not (rst.BOF And rst.EOF) Then
    rst.MoveFirst
    Me.[txtCategory] = Me.cboCategoryName.Column(1)
    Me.[txtCurrentSpend] = DSum("spent", "qryExpenseDetail", "category='" & Me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
    Me.[txtCategoryBudget] = DMax("[budget amount]", "qryExpenseDetail", "category='" & Me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
    Me.[txtBudgetRemaining] = [txtCategoryBudget] - [txtCurrentSpend]
End If
rst.Close
Set rst = Nothing
End Sub

Why do you open the recordset at all? You don't use it.

I have not looked closely at the code but I am pretty sure the whole process could be done a lot more efficiently in a query rather than all those Domain functions.

 

[arnelgp]

You dont need to use a recordset we already getting the data via dsum() and dmax().

 

[JHB]

.. Even typing the entire Category name using JHB's mods still does not populate the text fields. I have tried OnChange and OnUpdate but neither one made a difference in skipping over the code if only using the dropdown.
..

Could you post your database with some sample data, (do a Compact & Repair before, then Zip it)?

 

[tmguru]

Sure can - here it is.

Thanks!

-tmguru

 

[JHB]

You are using field name you don't have in your query.
Red text is what you had, blue is corrected too.

Private Sub cboCategoryName_AfterUpdate1()
  Dim dbs As DAO.Database
  Dim rst As DAO.Recordset
  Dim errtext As String
  Dim i As Integer
  'On Error GoTo Err_Name 'Comment out the errorhandler until the code runs okay, else you can't see which codeline cause the problem
  
  Set dbs = CurrentDb()
  Set rst = dbs.OpenRecordset("qryCurrentMonthSpend", dbOpenDynaset)
  'rst.MoveFirst 'You don't need MoveFirst, it would cause an error if the query doesn't return any records
  i = 0
  Do While Not rst.EOF
    If rst![Category] =[COLOR=Blue] Me.cboCategoryName.Column(1) [/COLOR]Then [COLOR=Red]'Me.cboCategoryName[/COLOR]
      Me.[txtCategory] = rst![Category]
      Me.[txtCurrentSpend] = rst![Spent]
      Me.[txtCategoryBudget] = [COLOR=Blue]rst![Budget Amt] [/COLOR][COLOR=red]'rst![Budget Amount][/COLOR]
      Me.[txtBudgetRemaining] = [COLOR=blue]rst![Budget Amt] - rst![Spent][/COLOR][COLOR=Red] 'rst![Budget Amount] - rst![Spent][/COLOR]
      'we got what was needed. Now exit
      Exit Do
    End If  'You need to have the End IF here, else you'll never move to next record if the first record isn't equal to cboCategoryName
    rst.MoveNext
    i = i + 1
    'End If  'Is in wrong place.
  Loop
  ' Cleanup
  rst.Close
  Set rst = Nothing
  Set dbs = Nothing
  Exit Sub

Err_Name:
  MsgBox ("There was an error! " & "i Value = " & i)
End Sub

And in the solution from arnelgp is the same, you are using field name you don't have in your query.

Private Sub cboCategoryName_AfterUpdate()
Dim dbs As Database
Dim rst As Recordset
Dim exp1 As Currency
Set dbs = CurrentDb()
'Set rst = dbs.OpenRecordset("select category, spent, [COLOR=Red][budget amount][/COLOR],[COLOR=red] [budget amount][/COLOR]-spent as exp1 from qryCurrentMonthSpend where category=""" & Me.cboCategoryName.Column(1) & """", dbOpenDynaset)
Set rst = dbs.OpenRecordset("select category, spent, [COLOR=Blue][budget amt][/COLOR], [COLOR=blue][budget amt][/COLOR]-spent as exp1 from qryCurrentMonthSpend where category=""" & Me.cboCategoryName.Column(1) & """", dbOpenDynaset)
If Not (rst.BOF And rst.EOF) Then
    rst.MoveFirst
    Me.[txtCategory] = Me.cboCategoryName.Column(1)
[COLOR=red]   'You don't have a field named "spent" in the "qryExpenseDetail"
[/COLOR]'    Me.[txtCurrentSpend] = DSum("spent", "qryExpenseDetail", "category='" & Me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
[COLOR=SeaGreen] [COLOR=Red]  'You don't have a field named "[budget amount]" in the "qryExpenseDetail"
[/COLOR][/COLOR]'    Me.[txtCategoryBudget] = DMax("[budget amount]", "qryExpenseDetail", "category='" & Me.cboCategoryName.Column(1) & "' and datepurchased between dateserial(year(date()),month(date()),1) and dateserial(year(date()),month(date())+1,0)")
    Me.[txtBudgetRemaining] = [txtCategoryBudget] - [txtCurrentSpend]
End If
rst.Close
Set rst = Nothing
End Sub

 

[tmguru]

Yikes!!

I see what you mean JHB. I never intended to use the qryExpenseDetail query in this procedure. I wrote a query qryCurrentMonthSpend which I used in the set rst line because it already has all of the fields I need except the calculated field which I obviously could add to the query anyway. However when I wrote the rest of code I inadvertently used the qryExpenseDetail reference instead of qryCurrentMonthSpend. I fixed my original code with the loop and now the txt fields populate (see below for the BUT...) Besides this now obvious mistake I think the key was appending .Column(1) to the match string.

Thanks to everyone for your help!!! As Galaxiom and others have stated, I'm 100% sure there's more efficient ways to write this and I plan on doing that.

BUT there is still one problem I haven't sorted out. In order to get the txtfields to populate I had to put the same procedure in the Got Focus property UNLESS I start typing the first few characters of the Category in the cboCategoryName combo box. So I now have the procedure in three properties, AfterUpdate, On Change and Got Focus. Obviously using Got Focus doesn't cover every scenario such as the user clicking elsewhere.

Here's what happens in each scenario:

For cboCategoryName combo box:
1. Choose from dropdown only (without Got Focus property) - No txtField data
2. Choose from dropdown only (with Got Focus property) - txtField data populates
3. Type first few characters of Category - txtField data populates during typing (when enough characters are typed to cause a match)
4. Auto populate after choosing an item from cboItemName drop down - No txtField data
5. Auto populate after choosing an item from cboItemName drop down and tab to or click on cboCatelgory Name (with Got Focus) - txtField data populates

It seems unnecessary to me to need to use three different properties to get 90% of what I would expect to happen. Even using Got Focus won't work if cboCategoryName is auto populated from the cboItemName combo box and the user skips to the Supplier or Price fields.

Can anyone explain why when there's new data in the cboCategoryName combo, that doesn't trigger either the After Update or On Change property?

Here is the code that's 'working' now except for the issue above:

Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim errtext As String
Dim i As Integer ' used for loop counting & debuggubg
'On Error GoTo Err_Name

Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("qryCurrentMonthSpend", dbOpenDynaset)
i = 0
Do While Not rst.EOF
If rst![Category] = Me.cboCategoryName.Column(1) Then
Me.[txtCategory] = rst![Category]
Me.[txtCurrentSpend] = rst![Spent]
Me.[txtCategoryBudget] = rst![Budget Amt]
Me.[txtBudgetRemaining] = rst![Budget Amt] - rst![Spent]
'we got what was needed. Now exit
Exit Do
End If
rst.MoveNext
i = i + 1
Loop
' MsgBox ("There is no spend in the category you selected so far this month.")
' Cleanup
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Sub

Err_Name:
MsgBox ("There was an error! " & "i Value = " & i)

Again, thanks SO much for everyone's suggestions and input! I really do appreciate your time.

-tmguru (but obviously NOT accessGuru - yet)

 

[JHB]

I'm sure the members here would be able to help you.
Maybe it is only me, but I've problem to understand what exactly your problem and requirement is, so could you give a description step by step, how to reproduce your problem and also the result you want, (sometimes a printscreen tells more as many words)?

 

[tmguru]

Thanks JHB.

The situation is that when a user enters something in the cboItemName combo box, the last Category used for that item auto populates in the cboCategoryName combo box. When that happens I expect that the AfterUpdate event or the OnChange event would trigger. But neither do. The procedures are exactly the same in both events and are why I started this thread as I could not get them to work at all. You all have helped me solve that and the code now correctly populates some text boxes on my form but only when one of two things happen:

1. When the user clicks or tabs to the cboCategoryName combo box (because I added the Got Focus event with the same procedure that's in AfterUpdate and On Change).

2. If the user starts typing a category name even if it's the same category name that's already populated in the box. I'm pretty sure that's the On Change event that is triggering.

If the user clicks to a different field without stopping at cboCategoryName no events will trigger even though the cboCategoryName box has been auto populated and has data in it.

In the attached screen shots you will see some examples that I hope will help visualize what is (not) happening.

Thanks!

-tmguru