Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Do I need an array?

Status
Not open for further replies.

PrincipalFuller

Programmer
Mar 21, 2012
4
US
Good Morning,

I'm somewhat of a novice in regards to VBA programming, but able to figure more things out. I'm writing a student management system for a school in Access, and I am writing a script that will compare three different tables, and make sure data is correct. I'm importing a file from the school district, taking our student list and comparing it to the district's, and then checking the free/reduced lunch status from the district list to make sure it is the same as in our DB.

So I have a table of the various status options, (i.e.: free, reduced, full, direct cert, etc.) and then three flags "Free", "Reduced", and "Full".

Right now I'm using DCOUNT to make sure it exists and then DLOOKUP to look up the district's list and then to lookup from the status options table.

But it is running VERY slow.

I don't know how to do an array, but I thought if i could load the district list and the status options into an array, what I want to know is if the district lists a kid with ID ### as "FREE" and then in the status options if "FREE" has a flag in the "Free" column.

Is there a way to do this with arrays? Everything I can find online about arrays is number based, and I need to be string based.

Thanks!
 
can you post what code you have now

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>
 
Current Code (that runs slow):

Function VerifyStatuses()

Dim stNotPPA
Dim stNotOnDistList
Dim stChangeToFree
Dim stChangeToReduced
Dim stChangeToFull

Set db = CurrentDb()

stFileName = Me![Text0] 'This is the file name to the Excel File. I would rather do it as a CSV if I can get it to work
DoCmd.TransferSpreadsheet acImport, 8, "Exc_Lch_StatusVerification", stFileName, True


stPPAKidsSQL = "SELECT dbo_Op_StatusOptions.Active, dbo_Ppl_Student.PPAID, dbo_Ppl_Student.PCSBID, [LastName] & ', ' & [FirstName] AS Student, dbo_Ppl_Student.Grade, dbo_Ppl_Student.FreeLunch, dbo_Ppl_Student.ReducedLunch FROM dbo_Ppl_Student INNER JOIN dbo_Op_StatusOptions ON dbo_Ppl_Student.Status = dbo_Op_StatusOptions.Status WHERE (((dbo_Op_StatusOptions.​Active)=True));"
Set rsStudent = db.OpenRecordset(stPPAKidsSQL, dbOpenDynaset)
rsStudent.MoveFirst
While Not rsStudent.EOF
Me!StudentName = rsStudent.Student
If DCount("[PCSBID]", "Exc_Lch_StatusVerification", "[PCSBID] = " & rsStudent.pcsbid) > 0 Then
stStatus = DLookup("[Status]", "Exc_Lch_StatusVerification", "[PCSBID] = " & rsStudent.pcsbid)
If DCount("[LunchVerOptionsID]", "dbo_Lch_LunchVerOptions", "[VerReportClassifier] = '" & stStatus & "'") > 0 Then
If DLookup("[Full Price]", "dbo_Lch_LunchVerOptions", "[VerReportClassifier] = '" & stStatus & "'") = True Then
If (rsStudent.FreeLunch = True) Or (rsStudent.ReducedLunch = True) Then
If rsStudent.FreeLunch = True Then stCurrent = "Free Lunch"
If rsStudent.ReducedLunch = True Then stCurrent = "Reduced Lunch"
stChangeToFull = stChangeToFull & rsStudent.Student & " (PCSBID: " & rsStudent.pcsbid & ") Changed from " & stCurrent & " to full paid." & Chr(13) & Chr(10)

stSQL2 = "SELECT PPAID, FreeLunch, ReducedLunch FROM dbo_Ppl_Student WHERE [PPAID] = " & rsStudent.PPAID & ";"
Set rs2 = db.OpenRecordset(stSQL2, dbOpenDynaset)
rs2.Edit
rs2.FreeLunch = False
rs2.ReducedLunch = False
rs2.Update
rs2.Close

End If
Else
If (DLookup("[FreeLunch]", "dbo_Lch_LunchVerOptions", "[VerReportClassifier] = '" & stStatus & "'") = True) And (rsStudent.FreeLunch = False) Then
If (rsStudent.FreeLunch = False) And (rsStudent.ReducedLunch = False) Then stCurrent = "Full paid"
If (rsStudent.ReducedLunch = True) Then stCurrent = "Redcued Lunch"
stChangeToFree = stChangeToFull & rsStudent.Student & " (PCSBID: " & rsStudent.pcsbid & ") Changed from " & stCurrent & " to Free Lunch." & Chr(13) & Chr(10)

stSQL2 = "SELECT PPAID, FreeLunch, ReducedLunch FROM dbo_Ppl_Student WHERE [PPAID] = " & rsStudent.PPAID & ";"
Set rs2 = db.OpenRecordset(stSQL2, dbOpenDynaset)
rs2.Edit
rs2.FreeLunch = True
rs2.ReducedLunch = False
rs2.Update
rs2.Close

End If

If (DLookup("[ReducedLunch]", "dbo_Lch_LunchVerOptions", "[VerReportClassifier] = '" & stStatus & "'") = True) And (rsStudent.ReducedLunch = False) Then
If (rsStudent.FreeLunch = False) And (rsStudent.ReducedLunch = False) Then stCurrent = "Full paid"
If (rsStudent.FreeLunch = True) Then stCurrent = "Redcued Lunch"
stChangeToReduced = stChangeToFull & rsStudent.Student & " (PCSBID: " & rsStudent.pcsbid & ") Changed from " & stCurrent & " to Reduced Lunch." & Chr(13) & Chr(10)

stSQL2 = "SELECT PPAID, FreeLunch, ReducedLunch FROM dbo_Ppl_Student WHERE [PPAID] = " & rsStudent.PPAID & ";"
Set rs2 = db.OpenRecordset(stSQL2, dbOpenDynaset)
rs2.Edit
rs2.FreeLunch = False
rs2.ReducedLunch = True
rs2.Update
rs2.Close

End If
End If
Else
MsgBox ("Something went wrong with " & rsStudent.Student)
End If
Else
strQuote = """"
stNotOnDistList = stNotOnDistList & rsStudent.pcsbid & ", " & rsStudent.PPAID & ", " & rsStudent.Grade & ", " & strQuote & rsStudent.Student & strQuote & Chr(13) & Chr(10)
End If
rsStudent.MoveNext
Wend


Dim filesys, filetxt
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set filesys = CreateObject("Scripting.​FileSystemObject")
Set filetxt = filesys.OpenTextFile("c:\​database\sendemail\​LunchStatusChanges.txt", ForWriting, True)
filetxt.writeline "Lunch Status Verification Completed at " & TimeValue(Now) & " on " & DateValue(Now)
filetxt.writeline ""
filetxt.writeline ""
filetxt.writeline "Students Changed To Full Paid Lunch:"
filetxt.writeline stChangeToFull
filetxt.writeline ""
filetxt.writeline "Students Changed To Reduced Lunch:"
filetxt.writeline stChangeToReduced
filetxt.writeline ""
filetxt.writeline "Students Changed To Free Lunch:"
filetxt.writeline stChangeToFree
filetxt.writeline ""
filetxt.writeline "Students Not Listed On PCSB Verification List:"
filetxt.writeline stNotOnDistList
filetxt.writeline ""
filetxt.writeline "End of Report"
filetxt.Close

Me!StudentName = "Complete"

End Function
 
start with proper declarations

Dim db as DAO.Database
Dim rs as DAO.Recordset
Dim rs2 as DAO.Recordset


also you should specify the data type in declarations

Dim stChangeToFree as [blue]String[/blue]

Other wise Access uses Variant as a default which can cause performance issues use the bang (!) as oppossed to dot for referencing records in recordsets. DLookups will cause a performance hit if you are process alot of records consider opening additional recordsets.

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>
 
Thanks for the tips.

If I open the second and third table as additional record sets instead of DLookup, I then would need to cycle through the entire table to find the match, correct? Or do I keep opening and closing the record set with a more specific SQL / WHERE. Or is there a way to have it match just the record from the set that matches?

For example, if I open rs!ID = 12345, and then need find the corresponding rs2!ID = 12345, is there a way to do that efficiently?

(Sorry I'm completely self taught, so I don't even know the right vocabulary to use to refer to these things)

Thanks!

 
I would leave it for now and change a few other things run and check for the performance so as suggested above fix up the declarations and check the performance.

Also Principal Fuller [smarty] I found a spelling error lol

If (rsStudent.ReducedLunch = True) Then stCurrent = [blue]"Redcued Lunch"[/blue] ... twice

If you were to use additional recordsets i would use the where clause. It is debatable which one would be quicker



HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>
 
I would definitely open a recordset for the table dbo_Lch_LunchVerOptions with the where clause it is used several times in your code and opening a recordset once will help. I went through the code and your declarations should look like this (without the addition of another rs)


Dim stNotPPA As String, stNotOnDistList As String, stChangeToFree As String
Dim stChangeToReduced As String, stChangeToFull As String, stFileName As String
Dim strQuote As String, stSQL2 As String
Dim stPPAKidsSQL As String, stStatus As String, stCurrent As String
Dim rsStudent As DAO.Recordset, rs2 As DAO.Recordset
Dim db As DAO.Database

for ease of read I would format the SQL like

Code:
stPPAKidsSQL = "SELECT dbo_Op_StatusOptions.Active, dbo_Ppl_Student.PPAID, " _
             & "dbo_Ppl_Student.PCSBID, [LastName] & ', ' & [FirstName] AS Student, " _
             & "dbo_Ppl_Student.Grade, dbo_Ppl_Student.FreeLunch, dbo_Ppl_Student.ReducedLunch " _
             & "FROM dbo_Ppl_Student " _
             & "INNER JOIN dbo_Op_StatusOptions ON dbo_Ppl_Student.Status = dbo_Op_StatusOptions.Status " _
             & "WHERE (((dbo_Op_StatusOptions.?Active)=True));"
I will continue to look at the code at a quick glance we can optimize it however it depends on how many records you loop through will determine the ultimate out come. To be honest I'm just getting over a sickness and I'm not quite up to speed.

(Sorry I'm completely self taught, so I don't even know the right vocabulary to use to refer to these things)

No worries, and so am I :) Self taught : formally certified :) in more ways then one hehe

HTH << MaZeWorX >> "I have not failed I have only found ten thousand ways that don't work" <<Edison>>
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top