Is there any way of speeding my code execution?

[Stapes]

Hi

I am trying to run the following procedure, which seems really slow.
The first input file rs_In has 1361 records in it. The file rs_In2 has
22690.
For each record on rs_In, the code is reading all of rs_In2 looking
for matches, and writing to rs_Out where matches are found. Some of
the fields are large. The name & address fields are 255 characters
apiece.
Does anybody have any suggestions for speeding this up?

Stapes


Dim db As Database
Dim qd As QueryDef
Dim rs_In As Recordset
Dim rs_In2 As Recordset
Dim rs_Out As Recordset
Set db = CurrentDb
Dim strsql As String
Dim percent As Integer
Dim in_rec As Integer
Dim in2_rec As Double

in_rec = 0
in2_rec = 0
strsql = "SELECT TTemp_TextImport.* FROM TTemp_TextImport;"
Set rs_In = db.OpenRecordset(strsql)
Set rs_Out = db.OpenRecordset("TTemp_ImportOut")
Do Until rs_In.EOF Or in_rec = 50
in_rec = in_rec + 1

strsql = "SELECT TM_Customers.* FROM TM_Customers;"
Set rs_In2 = db.OpenRecordset(strsql)
in2_rec = 0
Do Until rs_In2.EOF
in2_rec = in2_rec + 1
With rs_Out
.AddNew
.Fields("URN1") = rs_In.Fields("URN1")
.Fields("School URN") = rs_In.Fields("School URN")
.Fields("Title") = rs_In.Fields("Title")
.Fields("FirstName") = rs_In.Fields("FirstName")
.Fields("Surname") = rs_In.Fields("Surname")
.Fields("Job Title") = rs_In.Fields("Job Title")
.Fields("School Name") = rs_In.Fields("School Name")
.Fields("Address 1") = rs_In.Fields("Address 1")
.Fields("Address 2") = rs_In.Fields("Address 2")
.Fields("Address 3") = rs_In.Fields("Address 3")
.Fields("Town") = rs_In.Fields("Town")
.Fields("County") = rs_In.Fields("County")
.Fields("Postcode") = rs_In.Fields("Postcode")
.Fields("Country") = rs_In.Fields("Country")
.Fields("Add1") = rs_In2.Fields("Add1")
.Fields("Add2") = rs_In2.Fields("Add2")
.Fields("Add3") = rs_In2.Fields("Add3")
.Fields("CustTown") = rs_In2.Fields("Town")
.Fields("Pocd") = rs_In2.Fields("Pocd")
.Fields("CustCountry") = rs_In2.Fields("Country")
.Fields("Co") = rs_In2.Fields("Co")
percent = 0
If rs_In2.Fields("Add1") = rs_In.Fields(7) Then
.Fields("Add1 Flag") = 2
.Fields("Address 1 Flag") = 2
percent = percent + 10
'MsgBox "Match on add1:" & rs_In.Fields(7)
Else
If rs_In2.Fields("Add1") Like rs_In.Fields(7) & "*" And
Not IsNull(rs_In.Fields(7)) Then
'MsgBox "Partial Match on add1:" &
rs_In2.Fields("Add1") & " & " & rs_In.Fields(7)
.Fields("Add1 Flag") = 1
.Fields("Address 1 Flag") = 0
percent = percent + 5
Else
.Fields("Add1 Flag") = 0
.Fields("Address 1 Flag") = 0
End If
End If
If rs_In2.Fields("Add2") = rs_In.Fields(8) Then
'MsgBox "Match on add2:" & rs_In.Fields(8)
.Fields("Add2 Flag") = 2
.Fields("Address 2 Flag") = 2
percent = percent + 10
Else
If rs_In2.Fields("Add2") Like rs_In.Fields(8) & "*" And
Not IsNull(rs_In.Fields(8)) Then
'MsgBox "Partial Match on add2:" &
rs_In2.Fields("Add2") & " & " & rs_In.Fields(8)
.Fields("Add2 Flag") = 1
.Fields("Address 2 Flag") = 0
percent = percent + 5
Else
.Fields("Add2 Flag") = 0
.Fields("Address 2 Flag") = 0
End If
End If
If rs_In2.Fields("Add3") = rs_In.Fields(9) Then
'MsgBox "Match on add3:" & rs_In.Fields(9)
.Fields("Add3 Flag") = 2
.Fields("Address 3 Flag") = 2
percent = percent + 10
Else
If rs_In2.Fields("Add3") Like rs_In.Fields(9) & "*" And
Not IsNull(rs_In.Fields(9)) Then
'MsgBox "Partial Match on add3:" &
rs_In2.Fields("Add3") & " & " & rs_In.Fields(9)
.Fields("Add3 Flag") = 1
.Fields("Address 3 Flag") = 0
percent = percent + 5
Else
.Fields("Add3 Flag") = 0
.Fields("Address 3 Flag") = 0
End If
End If
If rs_In2.Fields("Town") = rs_In.Fields(10) Then
'MsgBox "Match on Town:" & rs_In.Fields(10)
.Fields("Town Flag") = 2
.Fields("CustTown Flag") = 2
percent = percent + 10
Else
If rs_In2.Fields("Town") Like rs_In.Fields(10) & "*" And
Not IsNull(rs_In.Fields(10)) Then
'MsgBox "Partial Match on Town:" &
rs_In2.Fields("Town") & " & " & rs_In.Fields(10)
.Fields("Town Flag") = 1
.Fields("CustTown Flag") = 0
percent = percent + 5
Else
.Fields("Town Flag") = 0
.Fields("CustTown Flag") = 0
End If
End If
If rs_In2.Fields("Cnty") = rs_In.Fields(11) Then
'MsgBox "Match on Cnty:" & rs_In.Fields(11)
.Fields("Cnty Flag") = 2
.Fields("County Flag") = 2
percent = percent + 10
Else
If rs_In2.Fields("Cnty") Like rs_In.Fields(11) & "*" And
Not IsNull(rs_In.Fields(11)) Then
'MsgBox "Partial Match on Cnty:" &
rs_In2.Fields("Cnty") & " & " & rs_In.Fields(11)
.Fields("Cnty Flag") = 1
.Fields("County Flag") = 0
percent = percent + 5
Else
.Fields("Cnty Flag") = 0
.Fields("County Flag") = 0
End If
End If
If rs_In2.Fields("Pocd") = rs_In.Fields(12) Then
'MsgBox "Match on Pocd:" & rs_In.Fields(12)
.Fields("Pocd Flag") = 2
.Fields("Postcode Flag") = 2
percent = percent + 10
Else
If rs_In2.Fields("Pocd") Like rs_In.Fields(12) & "*" And
Not IsNull(rs_In.Fields(12)) Then
'MsgBox "Partial Match on Pocd:" &
rs_In2.Fields("Pocd") & " & " & rs_In.Fields(12)
.Fields("Pocd Flag") = 1
.Fields("Postcode Flag") = 0
percent = percent + 5
Else
.Fields("Pocd Flag") = 0
.Fields("Postcode Flag") = 0
End If
End If
If rs_In2.Fields("Co") = rs_In.Fields(6) Then
'MsgBox "Match on Co:" & rs_In.Fields(6)
.Fields("Co Flag") = 2
.Fields("School Name Flag") = 2
percent = percent + 10
Else
If rs_In2.Fields("Co") Like rs_In.Fields(6) & "*" And Not
IsNull(rs_In.Fields(6)) Then
'MsgBox "Partial Match on Co:" & rs_In2.Fields("Co") &
" & " & rs_In.Fields(6)
.Fields("Co Flag") = 1
.Fields("School Name Flag") = 0
percent = percent + 5
Else
.Fields("Co Flag") = 0
.Fields("School Name Flag") = 0
End If
End If
If percent <> 0 Then
.Fields("percent") = percent
Debug.Print "Import Record " & in_rec & " Db Record " &
in2_rec & " - " & percent
.Update
End If

rs_In2.MoveNext
End With
Loop

rs_In.MoveNext


Loop
rs_Out.Close
MsgBox "Finished"
End Sub

 

[Guest]

Could try loading your small table into an array and looping through that
instead of requerying each time through. Should be a slight improvement each
time through, might add up to enough to make a difference.