VBA Function to loop through records on one table to query another

[KPR1977]

Ok, this is a tough one. I need to query “tblRawData” where “fldID” equals “fldLoop” in “tblLoop” and append the results into “tblResults”. If I were to do this exclusively in SQL, it would look something like this:

INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )
SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY
FROM tblRawData, tblLoop
where tblRawData.FldI D = tblLoop.fldLoop ;
Also, you can see this illustrated in my attached database in the “qryNormal” object.

Here’s where is get’s extremely difficult. The real “tblRawData” that I’m querying has over 6 million records, AND they are NOT indexed. Unfortunately there’s nothing I can do about that since I’m linking to an AS/400 table via ODBC. So this means Access/Jet will rad all 6 million recods to find the ones I want, which means it will time out long before it finishes pulling the data. So joining the tables in a simple query, like illustrated above, is not going to be possible for me.

Since “tblLoop” contains the values that I want to limit my search to in “tblRawData”, I can manually copy one value from “tblLoop” and paste it in my “where clause” as criteria for just querying “tblRawData” without the joins. When I do this, results are returned in a matter of seconds. This is illustrated in the “qryManual” in my attached database or see SQL below:

INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )
SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY
FROM tblRawData
WHERE FldID='001799'

I suppose that’s not a big deal when I only have 12 records in “tblLoop” to compare. But my real tblLoop could have up to 100,000 records (which isn’t as bad as 6 million, ha!). So needless to say, I want to avoid manually running an append query 100,000 times.

I think the solution lies within some sort of VBA function that will loop through “tblLoop” for “qryManual’s” where clause. If you see the attached Excel document how I have it diagrammed, it will make more sense. Also, I believe this is an example of what I’m trying to accomplish (see below), but it’s someone else’s query and code. I’m not sure how to make it work for my purposes, or if it’s what I need at all. Thanks for any help on this!!!

SQL

SELECT tbl_PIO_DATA.Series, LaborRate([Plant]) AS Labor, [Piocount]*LTSLookup([Vehicle],[PioCode])*LaborRate([Plant]) AS LaborTotal
FROM tbl_PIO_DATA

VBA

Function LaborRate(Plant)

    Dim db As DAO.Database
    Dim rec As Recordset
        
    Set db = CurrentDb()
    Set rec = db.OpenRecordset("Lookup_LaborRate", dbOpenDynaset)
      
    rec.MoveFirst
  While rec.EOF <> True
    If rec!Plant = Plant Then
        LaborRate = rec!Labor_Rate
        rec.MoveLast
    End If
    rec.MoveNext
  Wend

End Function

Function LTSLookup(Vehicle, PIOCode)

    Dim db As DAO.Database
    Dim rec As Recordset
        
    Set db = CurrentDb()
    Set rec = db.OpenRecordset("2007_LABOR_TIME", dbOpenDynaset)
      
    rec.MoveFirst
    
  While rec.EOF <> True
    
    If PIOCode = rec!CODE Then
         If rec![Vehicle Code] = "*" Then
            LTSLookup = rec!LTS
            rec.MoveLast
         ElseIf rec![Vehicle Code] = Vehicle Then
            LTSLookup = rec!LTS
            rec.MoveLast
         End If
    End If
    rec.MoveNext
    
  Wend
  

End Function

Function LTSExclude(Vehicle, PIOCode)

    Dim db As DAO.Database
    Dim rec As Recordset
        
    Set db = CurrentDb()
    Set rec = db.OpenRecordset("2007_LABOR_TIME", dbOpenDynaset)
      
    rec.MoveFirst
    
  While rec.EOF <> True
    
    If PIOCode = rec!CODE Then
         If rec![Vehicle Code] = "*" Then
            LTSExclude = rec!Exclude
            rec.MoveLast
         ElseIf rec![Vehicle Code] = Vehicle Then
            LTSExclude = rec!Exclude
            rec.MoveLast
         End If
    End If
    rec.MoveNext
    
  Wend
  

End Function

[Lysander]

You don't have to do it manually, you could open tblLoop as a recordset and set up a loop

While not rsLoop.EOF
  strSQL="INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )"
  strSQL=strSQL & " SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY
FROM tblRawData"
  strSQL=strSQL & " WHERE FldID='" & rsLoop!fldLoop & "'
 db.execute(strSQL);dbfailonerror
 rsLoop.movenext
WEND

or something like that.

[KPR1977]

Lysander, thanks! I bet this will work. I created a function for it below but I'm getting an error on this line of code:
db.execute(strS QL);dbfailonerr or

And it's asking me to define rsLoop (maybe because I have Option Explicit declared???). Anyhow, I'm a beginner with VBA, so I'm probably asking a real dumb question. Thanks for any ideas on how to make this work... =)

Public Function TestLoop()

While Not rsLoop.EOF
  strSQL = "INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )"
  strSQL = strSQL & " SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY " & _
                    "FROM tblRawData"
  strSQL = strSQL & " WHERE FldID='" & rsLoop!fldLoop & "' "
 
 db.execute(strSQL); dbfailonerror
 
 rsLoop.MoveNext
Wend


End Function

[Lysander]

Wow, fast response, give a few seconds to check it out.

ok, me bad, I did not give all the info, did not realise you were new to VBA

oops, that should be a comma, not a semi colon. I'll constuct the full function, actually, it should be a sub as it is not returning a value, in Acces and post it in a few minutes

AND ALWAYS HAVE OPTION EXPLICT DECLARED, it can be a lifesaver.

[Lysander]

ok, this compliles in Access 2003 but of course, I cant test it as I dont have those tables

Public Function TestLoop()
On Error GoTo TestLoop_Err
Dim rsLoop As Recordset
Dim strSQL As String
Dim db As Database

Set db = CurrentDb
Set rsLoop = db.OpenRecordset("Select * from tblLoop;")

rsLoop.MoveFirst
While Not rsLoop.EOF
  strSQL = "INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )"
  strSQL = strSQL & " SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY FROM tblRawData"
  strSQL = strSQL & " WHERE FldID='" & rsLoop!fldLoop & "' "
 
  db.Execute (strSQL), dbFailOnError
 
 rsLoop.MoveNext
Wend
rsLoop.Close
Set rsLoop = Nothing
Set db = Nothing

TestLoop_Exit:
   Exit Function
TestLoop_Err:
   MsgBox Err.Description & " in TestLoop"
   Resume TestLoop_Exit
End Function

[KPR1977]

I need to tell you the same thing I've told ADezii...please extend your hand and give yourself a great big firm handshake of appreciation from myself!!! Your code works great!!! It took about 15 minutes for it to run through 40,000 records in tblLoop. Thanks again!!! =)

[Lysander]

Glad it worked and that I could be of help, its what this site is all about:)

[KPR1977]

I love this site!!!!