Solved: Optimizing Code Speed

[Movian]

Hey,
i am currently developing an update system so that clients that have an older version of our database system can easily upgrade to a newer version. (at the moment we manually pull over their tables into a new database). To that end i have produced some code to compare 2 tables (new and old) and check if any entries in the old table do not exist in the new table and if they do not then the system will put that entry into the new table (this table represents combo box list options and has around 4000 records in it).
Now i know comparing 4000 records against another 4000 records in a nested loop is going to be slow at best so i want to try and optimize my code to make sure it isn't any slower than it HAS to be :)

any help is appreciated.


Dim NewDb As DAO.Database, Olddb As DAO.Database, NewLook As DAO.Recordset, OldLook As DAO.Recordset
Dim fld As Field, copied As Integer, compared As Integer
Dim exist As Boolean
Dim string1 As String, string2 As String, string3 As String

Set NewDb = OpenDatabase(CurrentProject.Path + "\SonoSoft.accdb")
Set Olddb = OpenDatabase(CurrentProject.Path + "\Data.accdb")
Set NewLook = NewDb.OpenRecordset("tblLookupValues")
Set OldLook = Olddb.OpenRecordset("tblLookupValues")

exist = False
copied = 0
compared = 0
OldLook.MoveLast
OldLook.MoveFirst
While Not OldLook.EOF
Screen.Application.Echo True
Me.percent.Caption = CStr(Round(OldLook.PercentPosition, 0)) & "% Complete"
Screen.Application.Echo False
NewLook.MoveFirst
exist = False

If Not IsNull(OldLook.Fields("form1")) Then
string1 = OldLook.Fields("form1")
Else
string1 = ""
End If
If Not IsNull(OldLook.Fields("control")) Then
string2 = OldLook.Fields("Control")
Else
string2 = ""
End If
If Not IsNull(OldLook.Fields("value")) Then
string3 = OldLook.Fields("Value")
Else
string3 = ""
End If

While Not NewLook.EOF
If string1 = NewLook.Fields("Form1") And string2 = OldLook.Fields("Control") And string3 = NewLook.Fields("Value") Then
exist = True
NewLook.MoveLast
End If
NewLook.MoveNext
Wend

If exist = False Then
NewLook.AddNew
NewLook.Fields("Form1").Value = string1
NewLook.Fields("Control").Value = string2
NewLook.Fields("Value").Value = string3
copied = copied + 1
NewLook.Update
End If
OldLook.MoveNext
compared = compared + 1
Wend

NewLook.Close
OldLook.Close
MsgBox "System has compared " + Str(compared) + " record(s) and has copied " + Str(copied) + " record(s).", vbInformation, "Complete"

[Tommy]

is this:
If string1 = NewLook.Fields("Form1") And string2 = OldLook.Fields("Control") And string3 = NewLook.Fields("Value") Then
supposed to be this:
If string1 = NewLook.Fields("Form1") And string2 = NewLook.Fields("Control") And string3 = NewLook.Fields("Value") Then
?

I think I would look at .FindFirst and .NoMatch just a suggestion.

[OBP]

Movian, is this for just Updating the data in the Tables or the actual Table Structure as well?
If it is just the data why not just VBA to run an Append and an Update Query?
They are much fatser than VBA for updating data.

[Movian]

Tommy
yes you are quite correct.... not sure how that one slipped by me !! :S

OBP is there an example of the option you suggested ?

i am unfamiliar with the process you mentioned but i am very willing to look into it. :)

this particular tables structure dosn't change. it allways has the same three fields and i do not see it changing in the foreseeable future.

(i have a seperate section of code that deals with pulling values into altered tables structures , i will be looking to go through and revamp that code aswell so i might aswell post that here aswell i supose :) )

case 1 is for upgrading a version 1 database to our current version 2

case 2 is for upgrading version 2.x to current


'This Sub is designed to move the data from the tables in old databases and put the information into the new system.
'Any fields which no longer exist in the new system or have been renamed will be droped.

On Error Resume Next
Select Case Me.From
Case 1
Dim NewDb As DAO.Database, Olddb As DAO.Database, NewPat As DAO.Recordset, OldTable As DAO.Recordset
Dim newvein As DAO.Recordset, oldpat As DAO.Recordset, oldecho As DAO.Recordset, newecho As DAO.Recordset
Dim oldvasc As DAO.Recordset, newvasc As DAO.Recordset, newvein2 As DAO.Recordset
Dim tdfpat As TableDef, tdfvein As TableDef, tdfvein2 As TableDef, tdfecho As TableDef, tdfvasc As TableDef
Dim fld As Field

Set NewDb = OpenDatabase(CurrentProject.Path + "\SonoSoft.accdb")
Set Olddb = OpenDatabase(CurrentProject.Path + "\Data.accdb")
Set NewPat = NewDb.OpenRecordset("tblPatient")
Set oldpat = Olddb.OpenRecordset("tblPatient")
Set newvein = NewDb.OpenRecordset("tblVeinSpecialist")
Set newvein2 = NewDb.OpenRecordset("tblVeinSpecialist2")
Set OldTable = Olddb.OpenRecordset("tblVeinSpecialist")
Set tdfpat = NewDb.TableDefs("tblPatient")
Set tdfvein = NewDb.TableDefs("tblVeinSpecialist")
Set tdfvein2 = NewDb.TableDefs("tblVeinSpecialist2")
Set tdfecho = NewDb.TableDefs("tblEcho-NucMed")
Set tdfvasc = NewDb.TableDefs("tblVascular")
Set oldecho = Olddb.OpenRecordset("tblEcho-NucMed")
Set newecho = NewDb.OpenRecordset("tblEcho-NucMed")
Set oldvasc = Olddb.OpenRecordset("tblVascular")
Set newvasc = NewDb.OpenRecordset("tblVascular")

OldTable.MoveFirst
oldecho.MoveFirst
oldvasc.MoveFirst
OldTable.Edit
NewPat.Edit
newvein.Edit
newecho.Edit
newvasc.Edit

'patient table
While Not oldpat.EOF
NewPat.AddNew
For Each fld In tdfpat.Fields
On Error Resume Next
NewPat.Fields(fld.Name).Value = oldpat.Fields(fld.Name).Value
On Error GoTo 0
Next
NewPat.Update
oldpat.MoveNext
Wend

'vein tables
While Not OldTable.EOF
newvein.AddNew

For Each fld In tdfvein.Fields
On Error Resume Next
newvein.Fields(fld.Name).Value = OldTable.Fields(fld.Name).Value
On Error GoTo 0
Next

newvein.Update
OldTable.MoveNext
Wend

'vein table 2
OldTable.MoveFirst
While Not OldTable.EOF
newvein2.AddNew

For Each fld In tdfvein2.Fields
On Error Resume Next
newvein2.Fields(fld.Name).Value = OldTable.Fields(fld.Name).Value
On Error GoTo 0
Next

newvein2.Update
OldTable.MoveNext
Wend


'echo table
While Not oldecho.EOF
newecho.AddNew

For Each fld In tdfecho.Fields
On Error Resume Next
newecho.Fields(fld.Name).Value = oldecho.Fields(fld.Name).Value
On Error GoTo 0
Next

newecho.Update
oldecho.MoveNext
Wend

'vascular table
While Not oldvasc.EOF
newvasc.AddNew

For Each fld In tdfvasc.Fields
On Error Resume Next
newvasc.Fields(fld.Name).Value = oldvasc.Fields(fld.Name).Value
On Error GoTo 0
Next
If newvasc.Fields("CarotidVals").Value = "" Or IsNull(newvasc.Fields("CarotidVals")) Then
newvasc.Fields("CarotidVals") = "^^^^^^^^^^^^^^^^^^^^^^^"
End If

newvasc.Update
oldvasc.MoveNext
Wend


NewPat.Close
newvein.Close
OldTable.Close
newecho.Close
newvasc.Close
oldecho.Close
oldvasc.Close
Case 2

Dim NewDb2 As DAO.Database, Olddb2 As DAO.Database
Dim NewPat2 As DAO.Recordset, OldTable2 As DAO.Recordset, NewTable As DAO.Recordset
Dim tdfpat2 As TableDef
Dim Databasename As String
Databasename = InputBox("Please enter the name of the database")

Set NewDb2 = OpenDatabase(CurrentProject.Path + "\SonoSoft.accdb")
Set Olddb2 = OpenDatabase(CurrentProject.Path + "\" + Databasename + ".mdb")

Set NewPat2 = NewDb2.OpenRecordset("tblPatient")
Set OldTable2 = Olddb2.OpenRecordset("Patient Database")

Set tdfpat2 = Olddb2.TableDefs("Patient Database")
If UCase(Databasename) = "ECHO" Or UCase(Databasename) = "NUCMED" Then
Set NewTable = NewDb2.OpenRecordset("tblEcho-NucMed")
Else
Set NewTable = NewDb2.OpenRecordset("tbl" + Databasename)
End If
OldTable.MoveFirst
While Not OldTable2.EOF
NewPat2.AddNew
NewTable.AddNew
For Each fld In tdfpat2.Fields
On Error Resume Next
NewPat2.Fields(fld.Name).Value = OldTable2.Fields(fld.Name).Value
NewTable.Fields(fld.Name).Value = OldTable2.Fields(fld.Name).Value
On Error GoTo 0
Next
NewPat2.Update
NewTable.Update
OldTable2.MoveNext
Wend
OldTable2.Close
NewTable.Close
NewPat2.Close
Case Else
End Select

[CreganTur]

i am unfamiliar with the process you mentioned but i am very willing to look into it.
You can build these 2 queries from the query builder in access- it'll step you through the process pretty easily. You'll probably want to use an Append query- it will append(add to the end) all specified records from Table1 to Table2.

An update query is really designed to update records that already exist in a table, so it might not be as helpful as an Append query.


I think I would look at .FindFirst and .NoMatch just a suggestion.
I agree with Tommy's suggestion- this would reduce your code overhead and speed up your process- just make sure you Find using your primary key value to speed things up even more.

In your code where you're initializing your variables you have:
NewPat.Edit
newvein.Edit
newecho.Edit
newvasc.Edit
Why are you putting all your recordsets into edit mode? It doesn't make sense because the very next thing you do is an .addnew command, which closes your edit and adds new space for a record. The .edit method is used for editing the currently selected record in the recordset.

nitpick: I personally avoid the While Wend loop structure for a few different reasons- a Do Until...Loop structure would accomplish the same thing for you. It's a personal preference:dunno

HTH:thumb

[OBP]

You can see an example of the process I and randy mentioned here

http://forums.techguy.org/business-applications/774891-access-2003-update-delete.html

in the database that I posted in Post #13

[Movian]

Ok so i have the SQL queries and a rough idea what to do however i am now left with a puzzle.

I have an old database "Data.accdb" a new database "SonoSoft.accdb" (although the whole point of this is so that i can update an .accdr) and we then have upgrade.accdb - how do i run a sql query to update a table in SonoSoft.accdb with the values from data.accdb :\ everything here is designed to run on tables in the same database ....

[OBP]

You import the data in to the new database in temporary Table(s), Append and Update the data and delete the Import Table(s)

[Movian]

surly that would take a fair amount of time to import two tables, append the information then export the tables again .... :\ i was hoping to avoid that but i will try it and see if it gives a noticeable increase or decrease

[CreganTur]

You import the data in to the new database in temporary Table(s), Append and Update the data and delete the Import Table(s)

If you don't have a lot of network lag you can also use ADO/DAO to link tables, so you could link the tables and then perform the SQL actions to update the records. I've got to run, but I'll post code snippets when I get back if needed.

[OBP]

Importing is almost instantaneous.

[CreganTur]

Just to verify, but I imagine that your individual users can have unique records in their tables, which is why you are having to compare them to the master tables and append the records, instead of dropping the old table and replacing it with the updated table and records.

[Movian]

Correct, we have a set of standard options for our combo boxes that are stord in the table. (form, control, value) the users are able to add their own custom options to each dropdown. When we upgrade their system we add in new drop downs so just using the old table is not an option and using just the new table would los their custom options. So we have to compare the old table against the new, and any options in the old table that are not in the new table need to be added to the new table... ironicly this table does not have a primary key (I did not design this section of our system.. i just have to make it work :\ ). Hope that clarifies the situation a little more :)


~edit

i get an error from the following SQL statement (error = From syntax error)

INSERT INTO FinishedtblLookupValues
SELECT * FROM NewtblLookupValues
UNION
SELECT * FROM OldtblLookupValues

[Movian]

Ok i have reduced my previous procedure to this newer procedure... however some of the values contain ' characters which apears to be causing issues, i have atempted to implements a replace check to remove the ' characters from the string however it does not apear to be working. aside from that everything "Apears" to be working much more efficiently. However in my research i discoverd someone mentioning that index and seek where quicker again than find first. Anyone know anything about that ?
Plus any help on the mystery of the non removed ' is again apriciated.

Dim NewDb As DAO.Database, Olddb As DAO.Database, NewLook As DAO.Recordset, OldLook As DAO.Recordset
Dim fld As Field, copied As Integer, compared As Integer
Dim findstring As String
Dim ValueString As String, counter As Integer

Set NewDb = OpenDatabase(CurrentProject.Path + "\SonoSoft.accdb")
Set Olddb = OpenDatabase(CurrentProject.Path + "\Data.accdb")
Set NewLook = NewDb.OpenRecordset("tblLookupValues", dbOpenDynaset)
Set OldLook = Olddb.OpenRecordset("tblLookupValues", dbOpenDynaset)

compared = 0
copied = 0


NewLook.MoveFirst

Do Until OldLook.EOF
Me.percent.Caption = Round(OldLook.PercentPosition, 0) & "% Complete"
If Not IsNull(OldLook.Fields("Value").Value) Then
ValueString = OldLook.Fields("Value").Value
Else
ValueString = ""
End If
Replace ValueString, "'", ""
findstring = "Form1='" & OldLook.Fields("Form1") & "' AND Control='" & OldLook.Fields("Control") & "' AND Value='" & ValueString & "'"
NewLook.FindFirst findstring

If NewLook.NoMatch = True Then
NewLook.AddNew
NewLook.Fields("Form1").Value = OldLook.Fields("Form1").Value
NewLook.Fields("Control").Value = OldLook.Fields("Control").Value
NewLook.Fields("Value").Value = OldLook.Fields("Value").Value
NewLook.Update
copied = copied + 1
End If

OldLook.MoveNext
compared = compared + 1

Loop

MsgBox Str(compared) & " entries compared and " & Str(copied) & " entries copied over"

NewLook.Close
OldLook.Close
Set NewLook = Nothing
Set OldLook = Nothing
End Sub

[CreganTur]

Your Replace function has the correct syntax, so I'm not sure why you're having trouble with it.

Using the .Seek method is faster because you're searching for records in an indexed field... but that's the issue- you have to be seeking on an indexed field. If you've got an index setup, then you're golden. Otherwise, stick with .Find or .FindFirst.

You need to add your databases to your cleanup procedures- reason: you opened the database; anything you open needs to be closed and then set = Nothing to clear up memory.

NewLook.Close
OldLook.Close
NewDB.Close
Olddb.Close
Set NewLook = Nothing
Set OldLook = Nothing
Set NewDB = Nothing
Set Olddb = Nothing


You're new code is much more compact than your previous version, which should help it run faster. I really hope it gives you the results and performance you want :thumb