By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,921 Members | 1,479 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,921 IT Pros & Developers. It's quick & easy.

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

P: 23
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.FldID = 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
Expand|Select|Wrap|Line Numbers
  1. SELECT tbl_PIO_DATA.Series, LaborRate([Plant]) AS Labor, [Piocount]*LTSLookup([Vehicle],[PioCode])*LaborRate([Plant]) AS LaborTotal
  2. FROM tbl_PIO_DATA
VBA
Expand|Select|Wrap|Line Numbers
  1. Function LaborRate(Plant)
  2.  
  3.     Dim db As DAO.Database
  4.     Dim rec As Recordset
  5.  
  6.     Set db = CurrentDb()
  7.     Set rec = db.OpenRecordset("Lookup_LaborRate", dbOpenDynaset)
  8.  
  9.     rec.MoveFirst
  10.   While rec.EOF <> True
  11.     If rec!Plant = Plant Then
  12.         LaborRate = rec!Labor_Rate
  13.         rec.MoveLast
  14.     End If
  15.     rec.MoveNext
  16.   Wend
  17.  
  18. End Function
  19.  
  20. Function LTSLookup(Vehicle, PIOCode)
  21.  
  22.     Dim db As DAO.Database
  23.     Dim rec As Recordset
  24.  
  25.     Set db = CurrentDb()
  26.     Set rec = db.OpenRecordset("2007_LABOR_TIME", dbOpenDynaset)
  27.  
  28.     rec.MoveFirst
  29.  
  30.   While rec.EOF <> True
  31.  
  32.     If PIOCode = rec!CODE Then
  33.          If rec![Vehicle Code] = "*" Then
  34.             LTSLookup = rec!LTS
  35.             rec.MoveLast
  36.          ElseIf rec![Vehicle Code] = Vehicle Then
  37.             LTSLookup = rec!LTS
  38.             rec.MoveLast
  39.          End If
  40.     End If
  41.     rec.MoveNext
  42.  
  43.   Wend
  44.  
  45.  
  46. End Function
  47.  
  48. Function LTSExclude(Vehicle, PIOCode)
  49.  
  50.     Dim db As DAO.Database
  51.     Dim rec As Recordset
  52.  
  53.     Set db = CurrentDb()
  54.     Set rec = db.OpenRecordset("2007_LABOR_TIME", dbOpenDynaset)
  55.  
  56.     rec.MoveFirst
  57.  
  58.   While rec.EOF <> True
  59.  
  60.     If PIOCode = rec!CODE Then
  61.          If rec![Vehicle Code] = "*" Then
  62.             LTSExclude = rec!Exclude
  63.             rec.MoveLast
  64.          ElseIf rec![Vehicle Code] = Vehicle Then
  65.             LTSExclude = rec!Exclude
  66.             rec.MoveLast
  67.          End If
  68.     End If
  69.     rec.MoveNext
  70.  
  71.   Wend
  72.  
  73.  
  74. End Function
Attached Files
File Type: zip Example Files.zip (251.5 KB, 315 views)
Apr 6 '10 #1
Share this Question
Share on Google+
7 Replies


Expert 100+
P: 344
You don't have to do it manually, you could open tblLoop as a recordset and set up a loop
Expand|Select|Wrap|Line Numbers
  1. While not rsLoop.EOF
  2.   strSQL="INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )"
  3.   strSQL=strSQL & " SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY
  4. FROM tblRawData"
  5.   strSQL=strSQL & " WHERE FldID='" & rsLoop!fldLoop & "'
  6.  db.execute(strSQL);dbfailonerror
  7.  rsLoop.movenext
  8. WEND
  9.  
or something like that.
Apr 6 '10 #2

P: 23
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(strSQL);dbfailonerror

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... =)
Expand|Select|Wrap|Line Numbers
  1. Public Function TestLoop()
  2.  
  3. While Not rsLoop.EOF
  4.   strSQL = "INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )"
  5.   strSQL = strSQL & " SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY " & _
  6.                     "FROM tblRawData"
  7.   strSQL = strSQL & " WHERE FldID='" & rsLoop!fldLoop & "' "
  8.  
  9.  db.execute(strSQL); dbfailonerror
  10.  
  11.  rsLoop.MoveNext
  12. Wend
  13.  
  14.  
  15. End Function
Apr 6 '10 #3

Expert 100+
P: 344
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.
Apr 6 '10 #4

Expert 100+
P: 344
ok, this compliles in Access 2003 but of course, I cant test it as I dont have those tables

Expand|Select|Wrap|Line Numbers
  1. Public Function TestLoop()
  2. On Error GoTo TestLoop_Err
  3. Dim rsLoop As Recordset
  4. Dim strSQL As String
  5. Dim db As Database
  6.  
  7. Set db = CurrentDb
  8. Set rsLoop = db.OpenRecordset("Select * from tblLoop;")
  9.  
  10. rsLoop.MoveFirst
  11. While Not rsLoop.EOF
  12.   strSQL = "INSERT INTO tblResults ( FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY )"
  13.   strSQL = strSQL & " SELECT FldID, SRCTNE, SRYRNE, SRSER2, SRFMLY FROM tblRawData"
  14.   strSQL = strSQL & " WHERE FldID='" & rsLoop!fldLoop & "' "
  15.  
  16.   db.Execute (strSQL), dbFailOnError
  17.  
  18.  rsLoop.MoveNext
  19. Wend
  20. rsLoop.Close
  21. Set rsLoop = Nothing
  22. Set db = Nothing
  23.  
  24. TestLoop_Exit:
  25.    Exit Function
  26. TestLoop_Err:
  27.    MsgBox Err.Description & " in TestLoop"
  28.    Resume TestLoop_Exit
  29. End Function
  30.  
  31.  
Apr 6 '10 #5

P: 23
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!!! =)
Apr 6 '10 #6

Expert 100+
P: 344
Glad it worked and that I could be of help, its what this site is all about:)
Apr 6 '10 #7

P: 23
I love this site!!!!
Apr 6 '10 #8

Post your reply

Sign in to post your reply or Sign up for a free account.