Do while loop with multiple recordsets

[GPSPOW]

I have been wrestling with the following VBA code for the last two days. I am endeavoring to take a table of payment factors (2 records) and extract from it the correct record that matches the parameter passed from the control table, which has 1145 records. The purpose is to create a new table with 1145 records that pass the key field from the control table and the correct fields from the Payment Factors table.

When I run the SUB, the query I have created to get the data from the factors tables based on the parameter, StartDate >= vDisDate and EndDate<= vDisDate gives me a "Run Time Error 3061. Two Few Parameters. Expected 1.

Option Compare Database

Public Sub Rates()

Dim vWI As Variant
Dim vSTDRT As Variant
Dim vLBRSHR As Variant
Dim vFEDNL As Variant
Dim vIMEDSH As Variant
Dim vCAPFEDRT As Variant
Dim vLRGURBAN As Variant
Dim vCAPIMEDSH As Variant
Dim vGAF As Variant
Dim vOPERCCR As Variant
Dim vCAPCCR As Variant
Dim vLBRREL As Variant
Dim vNONREL As Variant
Dim vFIXLOSS As Variant
Dim vRATIO As Variant
Dim vSDATE As Date
Dim vEDATE As Date
Dim vVisitID As String
Dim vDisDate As Date
Dim X As Integer
Dim Z As Integer
Dim RecCount As Integer


Dim RST As DAO.Recordset
Dim RST1 As DAO.Recordset
Dim RST2 As DAO.Recordset


Set RST = CurrentDb.OpenRecordset("TblDischargeList", dbOpenDynaset)

Set RST2 = CurrentDb.OpenRecordset("TblMedicareFactors_VisitID", dbOpenDynaset)

With RST

Do While Not RST.EOF

TempVars.Add "vVisitID", RST![VisitID].Value
TempVars.Add "vDisDate", RST![DischargeDateTime].Value

Set RST1 = CurrentDb.OpenRecordset("qrySubRates", dbOpenDynaset)


With RST1
vWI.Value = !WI
vSTDRT.Value = !StdRate
vFEDNL.Value = !FedNonLbr
vIMEDSH.Value = !IME_DSH
vCAPFEDRT.Value = !CAPFEDRT
vLRGURBAN.Value = !LargeUrban
vCAPIMEDSH.Value = !CapIME_DSH
vGAF.Value = !GAF
vOPERCCR.Value = !OperCCR
vCAPCCR.Value = !CapOLCCR
vLBRREL.Value = !LBRRel
vNONREL.Value = !NonLBRRel
vFIXLOSS.Value = !FixedLoss
vRATIO.Value = !Ratio
vSDATE = !StartDate.Value
vEDATE = !EndDate.Value
End With



With RST2
.AddNew
![VisitID].Value = [TempVars]![vVisitID]
![WageIndex].Value = vWI
![StdRate].Value = vSTDRT
![FedNonLbr].Value = vFEDNL
![IME_DSH].Value = vIMEDSH
![CAPFEDRT].Value = vCAPFEDRT
![LargeUrban].Value = vLRGURBAN
![CapIME_DSH].Value = vCAPIMEDSH
![GAF].Value = vGAF
![OperCCR].Value = vOPERCCR
![CapOLCCR].Value = vCAPCCR
![LBRRel].Value = vLBRREL
![NonLBRRel].Value = vNONREL
![FixedLoss].Value = vFIXLOSS
![Ratio].Value = vRATIO
![StartDate].Value = vSDATE
![EndDate].Value = vEDATE
.Update
End With
RST.MoveNext



Loop

End With














End Sub


Any help with this will be greatly appreciated.

GPSPOW

 

[PNGBill]

[CODESet RST2 = CurrentDb.OpenRecordset("TblMedicareFactors_VisitI D", dbOpenDynaset)

][/CODE]
You have a space in your table name.

Please use code posting facility (hash symbols)
Table and Field Names with spaces will not make life easier.

Add

Option Explicit

to your Class Module heading.

You should also set your database

Dim dbs As DAO.Database
Set dbs = CurrentDb

 

[PNGBill]

Also, you should Close your Recordsets when finished with them and set the to Nothing

 

[GPSPOW]

I am still not getting it.

The italicized and underlined SET RST1 code is where the Run time error occurs.

Thanks

Here is the revised code:

Option Compare Database
Option Explicit


Public Sub Rates()

Dim dbs As DAO.Database
Dim vWI As Variant
Dim vSTDRT As Variant
Dim vLBRSHR As Variant
Dim vFEDNL As Variant
Dim vIMEDSH As Variant
Dim vCAPFEDRT As Variant
Dim vLRGURBAN As Variant
Dim vCAPIMEDSH As Variant
Dim vGAF As Variant
Dim vOPERCCR As Variant
Dim vCAPCCR As Variant
Dim vLBRREL As Variant
Dim vNONREL As Variant
Dim vFIXLOSS As Variant
Dim vRATIO As Variant
Dim vSDATE As Date
Dim vEDATE As Date
Dim vVisitID As String
Dim vDisDate As Date
Dim X As Integer
Dim Z As Integer
Dim RecCount As Integer


Dim RST As DAO.Recordset
Dim RST1 As DAO.Recordset
Dim RST2 As DAO.Recordset

Set dbs = CurrentDb

Set RST = dbs.OpenRecordset("TblDischargeList", dbOpenDynaset)

Set RST2 = dbs.OpenRecordset("TblMedicareFactors_VisitID", dbOpenDynaset)

With RST

Do While Not RST.EOF

TempVars.Add "vVisitID", RST![VisitID].Value
TempVars.Add "vDisDate", RST![DischargeDateTime].Value

Set RST1 = dbs.OpenRecordset("qrySubRates", dbOpenDynaset)


With RST1
vWI.Value = !WI
vSTDRT.Value = !StdRate
vFEDNL.Value = !FedNonLbr
vIMEDSH.Value = !IME_DSH
vCAPFEDRT.Value = !CAPFEDRT
vLRGURBAN.Value = !LargeUrban
vCAPIMEDSH.Value = !CapIME_DSH
vGAF.Value = !GAF
vOPERCCR.Value = !OperCCR
vCAPCCR.Value = !CapOLCCR
vLBRREL.Value = !LBRRel
vNONREL.Value = !NonLBRRel
vFIXLOSS.Value = !FixedLoss
vRATIO.Value = !Ratio
vSDATE = !StartDate.Value
vEDATE = !EndDate.Value
End With



With RST2
.AddNew
![VisitID].Value = [TempVars]![vVisitID]
![WageIndex].Value = vWI
![StdRate].Value = vSTDRT
![FedNonLbr].Value = vFEDNL
![IME_DSH].Value = vIMEDSH
![CAPFEDRT].Value = vCAPFEDRT
![LargeUrban].Value = vLRGURBAN
![CapIME_DSH].Value = vCAPIMEDSH
![GAF].Value = vGAF
![OperCCR].Value = vOPERCCR
![CapOLCCR].Value = vCAPCCR
![LBRRel].Value = vLBRREL
![NonLBRRel].Value = vNONREL
![FixedLoss].Value = vFIXLOSS
![Ratio].Value = vRATIO
![StartDate].Value = vSDATE
![EndDate].Value = vEDATE
.Update
End With
RST.MoveNext



Loop

End With














End Sub

 

[PNGBill]

Test qrySubRates. It may well have an error in it.

 

[VilaRestal]

I notice there's a With RST without a closing End With before the With RST1

Actually the End With for the With RST is at the end. You can't do that: You can only nest Withs if the nested With is an extension of the first:

With RST
With .Fields

End With
End With

is ok

With RST
With RST1

End With
End With

is not

That can produce misleading errors in the compiler

 

[vbaInet]

Just wondering why you're needing to create a new table every time a parameter is searched for? A SELECT query should be sufficient for your needs. Could you justify this?

By the way, a simple MAKE TABLE QUERY would do what you require. No need for recordset.

 

[GPSPOW]

I have two Tables:

Patients
Factors

I want to merge the Patients and Factors together in to query with the following:

Patients.VisitID
Factors.DataField(s)

Where the Factors.StartDate >= Patients.DischargeDate and Factors.EndDate <= Patients.DischargeDate.

There are 1145 records in the Patients Table and 2 records in the Factors table. The query output should be 1145 records.

Thanks

 

[vbaInet]

So what about a SELECT query with those parameters specified in the WHERE clause?

 

[GPSPOW]

Here is the Select query I created. When I run it, I receive no data.


SELECT tblDischargeList.VisitID, tblDischargeList.DischargeDateTime, TblMedicareFactors.StartDate, TblMedicareFactors.EndDate, TblMedicareFactors.WageIndex, TblMedicareFactors.FedNonLbr, TblMedicareFactors.IME_DSH, TblMedicareFactors.CapFedRt, TblMedicareFactors.LargeUrban, TblMedicareFactors.CapIME_DSH, TblMedicareFactors.GAF, TblMedicareFactors.OperCCR, TblMedicareFactors.CapOLCCR, TblMedicareFactors.LBRRel, TblMedicareFactors.NonLBRRel, TblMedicareFactors.FixedLoss, TblMedicareFactors.Ratio
FROM TblMedicareFactors, tblDischargeList
WHERE (((TblMedicareFactors.StartDate)>=[tblDischargeList]![DischargeDateTime]) AND ((TblMedicareFactors.EndDate)<=[tblDischargeList]![DischargeDateTime]));

 

[vbaInet]

That's not logical. How does it know which DischargeDateTime to use if you have multiple records?

Replace [tblDischargeList]![DischargeDateTime] with static dates that actually exist in your table and it should return a result.

 

[GPSPOW]

There are numerous DischargeDates within the tblDischargeList. This is why I was trying to loop through the tblDischargeList and store the VisitID and DischargeDate to variables. Then I would use the variables to find the correct Factor record and update a third table.

Thanks

 

[VilaRestal]

I don't think it is illogical. For each row of the union join of the two tables, it will do the comparison and include it if it passes the test.

The thing that seems illogical to me is:

WHERE (((TblMedicareFactors.StartDate)>=[tblDischargeList]![DischargeDateTime]) AND ((TblMedicareFactors.EndDate)<=[tblDischargeList]![DischargeDateTime]));

i.e.

WHERE StartDate>=DischargeDateTime AND EndDate<=DischargeDateTime;

That would only show records where EndDate < StartDate. Are you sure you've got them the right way round? Shouldn't it at least be:

WHERE TblMedicareFactors.StartDate <= tblDischargeList.DischargeDateTime AND TblMedicareFactors.EndDate >= tblDischargeList.DischargeDateTime
?

 

[vbaInet]

Alright, I see. But you shouldn't be saving calculated values. What's the main aim of this? Are you going to display this on a form or a report? If you are there are other ways.

With regards your original post:

1. Use one recordset to pull the records in your DischargeList table and loop through this rs
2. For each value, call an UPDATE query or run an UPDATE statement (instead of using a second recordset).

 

[vbaInet]

I don't think it is illogical. For each row of the union join of the two tables, it will do the comparison and include it if it passes the test.

For the purpose of what the OP is trying to do it is illogical. The conditions will not match correctly and the wrong records will be updated (if successful).

 

[VilaRestal]

Agreed. It's just illogical isn't the word I'd use and not for that reason.

I want to merge the Patients and Factors together in to query with the following:

Patients.VisitID
Factors.DataField(s)

Where the Factors.StartDate >= Patients.DischargeDate and Factors.EndDate <= Patients.DischargeDate.

Surely that arrangement of StartDate > EndDate is always going to return no records (unless they're very strange definitions of start and end).

 

[GPSPOW]

I have tried it one more time..

Here is my latest code...

Option Compare Database

Public Sub Add_Factors()
Dim SQL As String
Dim vVisitID As String
Dim vDisDate As Date
Dim qrydef As QueryDef
Dim RST As DAO.Recordset
Dim RST1 As DAO.Recordset

Set RST = CurrentDb.OpenRecordset("TblDischargeList", dbOpenDynaset)
Set RST2 = CurrentDb.OpenRecordset("TblMedicareFactors_VisitID", dbOpenDynaset)

SQL = "Update TblMedicareFactors_VisitID " & _
SQL = SQL & "SET [VisitID] = vVisitID.value, [StdRate] = RST2!StdRate.value, " & _
SQL = SQL & "[FixedLoss] = RST2!FixedLoss.value" & _
SQL = SQL & " From RST2 Where RST2!StartDate <= vDisDate.value and RST2!EndDate <= vDisDate.value;"


CurrentDb.QueryDefs.Delete ("qryUpdFactors")
Set qrydef = CurrentDb.CreateQueryDef("qryUpdFactors", SQL)


With RST
Do While Not RST.EOF
vVisitID = RST![VisitID]
vDisDate = RST![DischargeDateTime]

DoCmd.OpenQuery "qryUpdFactors", acViewNormal

.MoveNext
Loop
End With
End Sub

I keep getting a data type mismatch error from the SQL code.

Thanks

GPSPOW

 

[VilaRestal]

There's a few errors in that code but the whole code needs ditching and starting again because the way you're trying to do it is all wrong.

But in passing, it's worth mentioning that in the lines where you assign SQL string a value:
Variables don't have properties (vVisitID.value should just be vVisitID)
The Jet engine is not aware of any objects you declare in the code or controls on the form so you can't reference them in the SQL string. You have to concatenate their values into the string.

But that's not what you want to do here anyway.

If you're updating the values of records with an Update SQL command you don't need any recordsets (and no looping through them).

Get the Select statement working first. Make sure you're going to be updating the correct records. Build that in the query designer. When it's working, you can the copy the SQL into VBA and turn it into a an Update SQL command that you can execute with DoCmd.RunSQL strSQL.

But get the Select right first. That's the hard bit it seems.

It's a lot easier to test and tweak the design of that in the query designer that in VBA.

I think you should try:

SELECT tblDischargeList.VisitID, tblDischargeList.DischargeDateTime, TblMedicareFactors.StartDate, TblMedicareFactors.EndDate, TblMedicareFactors.WageIndex, TblMedicareFactors.FedNonLbr, TblMedicareFactors.IME_DSH, TblMedicareFactors.CapFedRt, TblMedicareFactors.LargeUrban, TblMedicareFactors.CapIME_DSH, TblMedicareFactors.GAF, TblMedicareFactors.OperCCR, TblMedicareFactors.CapOLCCR, TblMedicareFactors.LBRRel, TblMedicareFactors.NonLBRRel, TblMedicareFactors.FixedLoss, TblMedicareFactors.Ratio
FROM TblMedicareFactors, tblDischargeList
WHERE (((TblMedicareFactors.StartDate)<=[tblDischargeList]![DischargeDateTime]) AND ((TblMedicareFactors.EndDate)>=[tblDischargeList]![DischargeDateTime]));

The same as you did before but with < and > swapped.

If that doesn;t show the right records then we can talk about why.

If it does then we can explain how to make into VBA code that will update those records.

But the important point is scrap the VBA code you've just posted. It's wrong on too many levels.

 

[GPSPOW]

Thanks.

That worked perfectly.

I guess the simplest solution (gordian's knot) is always the best solution.

 

[VilaRestal]

Good to hear. You're welcome