eats memory and generates maximum size error

[ballizz]

The code below keeps increasing the size of the database until max size (1 G) is reached, at which time it errors out. Can anyone point out to me which area(s) are causing this? The "Check_" table, after running 2090 records (the highest count I've gotten to) only has 14 records at that point.

Option Compare Database
Option Explicit
'Cleans and validates data immediately prior to output.
Public Function clean_and_validate()
Dim rcd As Recordset, rcd1 As Recordset, rcd2 As Recordset, rcd3 As Recordset
Dim flag As Integer, total1 As Integer, ind0 As Integer, seq As Integer, tleng As Integer, counter As Integer
Dim x As Integer, y As Integer, ind As Integer, ind1 As Integer, total As Integer, nflag As Integer
Dim fldname As String, flddata As String, simin As String, lineout As String, term1 As String, fterm As String
Dim noun As String, modf As String, term As String, tablename As String, test As String, term2 As String
Dim sstr As String
Dim optionset1, optionset2, optionset3
Dim qry As QueryDef, qry1 As QueryDef
Dim fld1 As field, fld2 As field, fld3 As field, fld4 As field
Dim idx As Index
Dim vtable As TableDef

tablename = InputBox("Enter table name to process: ", "Table:", "Working&quot
optionset1 = Application.GetOption("Confirm Document Deletions&quot
optionset2 = Application.GetOption("Confirm Action Queries&quot
optionset3 = Application.GetOption("Confirm Record Changes&quot

Application.SetOption "Confirm Document Deletions", 0
Application.SetOption "Confirm Action Queries", 0
Application.SetOption "Confirm Record Changes", 0

'Creates error table.
Set vtable = CurrentDb.CreateTableDef("Check_" & tablename)
With vtable
Set fld1 = vtable.CreateField("SIM", dbText, 20)
Set fld2 = vtable.CreateField("Field Name", dbText)
Set fld3 = vtable.CreateField("Invalid Data", dbMemo)
Set fld4 = vtable.CreateField("Error Condition", dbText)
vtable.Fields.Append fld1
vtable.Fields.Append fld2
vtable.Fields.Append fld3
vtable.Fields.Append fld4
vtable.Fields.Refresh
CurrentDb.TableDefs.Append vtable
CurrentDb.TableDefs.Refresh
End With

Set rcd2 = CurrentDb.OpenRecordset("Check_" & tablename)

Set qry = CurrentDb.CreateQueryDef("Temp_Query&quot
qry.SQL = "SELECT [_SMD].Noun, [_SMD].Modifier, [_SMD].Seq, [_SMD].Characteristic FROM _SMD"
qry.Close
CurrentDb.QueryDefs.Refresh

'Opens working recordset.
Set rcd = CurrentDb.OpenRecordset(tablename)
total = (rcd.Fields.count) - 2

With rcd
.MoveFirst
counter = 1

While Not .EOF

For x = 0 To total

If rcd.Fields(x).name = "SIM" Then
For y = 1 To Len(!sim)
If Val(Mid(!sim, y, 1)) = 0 And (Mid(!sim, y, 1)) <> &quot;0&quot; Then
flag = 1
lineout = &quot;SIM Error - contains non-numerics: &quot; & (Mid(!sim, y, 1))
GoSub 100
End If
Next y

If Len(!sim) <> 11 Then
flag = 1
lineout = &quot;SIM Error: &quot; & Len(!sim) & &quot; characters&quot;
GoSub 100
End If

If Left(!sim, 6) <> !Mfr_No Then
flag = 1
lineout = &quot;Mismatched with Mfr_No &quot; & !Mfr_No
GoSub 100
End If

If Right(!sim, 5) <> !Item_No Then
flag = 1
lineout = &quot;Mismatched with Item_No &quot; & !Item_No
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Mfr_No&quot; Then
If IsNull(!Mfr_No) Then
flag = 1
lineout = &quot;Missing Mfr_No&quot;
.Edit
!Mfr_No = &quot;Null&quot;
GoSub 100
End If

For y = 1 To Len(!Mfr_No)
If Val(Mid(!Mfr_No, y, 1)) = 0 And (Mid(!Mfr_No, y, 1)) <> &quot;0&quot; And !Mfr_No <> &quot;Null&quot; Then
flag = 1
lineout = &quot;Mfr_No Error - contains non-numerics: &quot; & (Mid(!Mfr_No, y, 1))
GoSub 100
End If
Next y

If Len(!Mfr_No) <> 6 And !Mfr_No <> &quot;Null&quot; Then
flag = 1
lineout = &quot;Mfr_No Error: &quot; & Len(!Mfr_No) & &quot; characters&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Item_No&quot; Then
If IsNull(!Item_No) Then
flag = 1
lineout = &quot;Missing Item_No&quot;
.Edit
!Item_No = &quot;Null&quot;
GoSub 100
End If

For y = 1 To Len(!Item_No)
If Val(Mid(!Item_No, y, 1)) = 0 And (Mid(!Item_No, y, 1)) <> &quot;0&quot; And !Item_No <> &quot;Null&quot; Then
flag = 1
lineout = &quot;Item_No Error - contains non-numerics: &quot; & (Mid(!Item_No, y, 1))
GoSub 100
End If
Next y

If Len(!Item_No) <> 5 And !Item_No <> &quot;Null&quot; Then
flag = 1
lineout = &quot;Item_No Error: &quot; & Len(!Item_No) & &quot; characters&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Manufacturer&quot; Then
If IsNull(!Manufacturer) Then
flag = 1
lineout = &quot;Missing Manufacturer&quot;
.Edit
!Manufacturer = &quot;Null&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Part_No&quot; Then
If IsNull(!PART_No) Then
flag = 1
lineout = &quot;Missing Part_No&quot;
.Edit
!PART_No = &quot;Null&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Major_CC&quot; Then
If IsNull(!major_cc) Then
flag = 1
lineout = &quot;Missing Category code&quot;
.Edit
!major_cc = &quot;MT&quot;
GoSub 100
End If

For y = 1 To Len(!major_cc)
If Val(Mid(!major_cc, y, 1)) = 0 And (Mid(!major_cc, y, 1)) <> &quot;0&quot; And !major_cc <> &quot;MT&quot; Then
flag = 1
lineout = &quot;Major_CC Error - contains non-numerics: &quot; & (Mid(!major_cc, y, 1))
GoSub 100
End If
Next y
End If

If rcd.Fields(x).name = &quot;MajorCode&quot; Then
If IsNull(!majorcode) Then
flag = 1
lineout = &quot;Missing Major code description&quot;
.Edit
!majorcode = &quot;Null&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Noun&quot; Then
If IsNull(!noun) Then
flag = 1
nflag = 1
lineout = &quot;Missing Noun&quot;
.Edit
!noun = &quot;Null&quot;
GoSub 100
End If

Set rcd1 = CurrentDb.OpenRecordset(&quot;_SMD&quot
noun = rcd!noun
rcd1.FindFirst &quot;Noun = '&quot; & noun & &quot;'&quot;
If rcd1.NoMatch Then
flag = 1
nflag = 1
lineout = &quot;Invalid Noun&quot;
GoSub 100
End If
rcd1.Close
End If

If rcd.Fields(x).name = &quot;Modifier&quot; Then
If IsNull(!modifier) Then
flag = 1
nflag = 1
lineout = &quot;Missing Modifier&quot;
.Edit
!modifier = &quot;Null&quot;
End If

Set rcd1 = CurrentDb.OpenRecordset(&quot;_SMD&quot
modf = rcd!modifier
rcd1.FindFirst &quot;Modifier = '&quot; & modf & &quot;'&quot;
If rcd1.NoMatch Then
flag = 1
nflag = 1
lineout = &quot;Invalid Modifier&quot;
GoSub 100
End If
rcd1.Close
End If

If nflag <> 1 Then
If Left(rcd.Fields(x).name, 14) = &quot;Characteristic&quot; Then
If Not (IsNull(rcd.Fields(x))) And (IsNull(rcd.Fields(x + 1))) Then
flag = 1
lineout = &quot;No corresponding value for Characteristic&quot;
GoSub 100
End If

If Not IsNull(rcd.Fields(x)) Then
term = rcd.Fields(x)
End If

qry.SQL = &quot;SELECT [_SMD].Noun, [_SMD].Modifier, [_SMD].Seq, [_SMD].Characteristic FROM _SMD &quot; & _
&quot;WHERE ((([_SMD].Noun)= '&quot; & noun & &quot;') AND (([_SMD].Modifier)= '&quot; & modf & &quot;'))&quot;

Set rcd3 = CurrentDb.OpenRecordset(&quot;Temp_Query&quot
rcd3.FindFirst &quot;Characteristic = '&quot; & term & &quot;'&quot;
If rcd3.NoMatch Then
term1 = rcd.Fields(x).name
tleng = Len(term1)
term2 = Val(Right(term1, (tleng - 14)))

qry.SQL = &quot;SELECT [_SMD].Noun, [_SMD].Modifier, [_SMD].Seq, [_SMD].Characteristic FROM _SMD &quot; & _
&quot;WHERE ((([_SMD].Noun)= '&quot; & noun & &quot;') AND (([_SMD].Modifier)= '&quot; & modf & &quot;') and (([_SMD].Seq)=&quot; & term2 & &quot)&quot;

With rcd3
.MoveFirst
fterm = rcd3!Characteristic
rcd.Edit
rcd.Fields(x) = fterm
rcd.Update
End With
End If
End If
End If

If rcd.Fields(x).name = &quot;dss_UOM&quot; Then
If !dss_UOM <> &quot;E&quot; And !dss_UOM <> &quot;C&quot; And !dss_UOM <> &quot;M&quot; And Not IsNull(!dss_UOM) Then
flag = 1
lineout = &quot;Invalid dss Unit of measure&quot;
GoSub 100
End If

If IsNull(!dss_UOM) Then
flag = 1
lineout = &quot;Missing dss Unit of measure&quot;
.Edit
!dss_UOM = &quot;0&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;PCF&quot; Then
If IsNull(!PCF) Then
flag = 1
lineout = &quot;Missing PCF&quot;
.Edit
!PCF = 0
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;unit_of_measure&quot; Then
If IsNull(!unit_of_measure) Then
flag = 1
lineout = &quot;Missing unit_of_measure&quot;
.Edit
!unit_of_measure = &quot;Null&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;unit_of_issue_abbrev&quot; Then
If IsNull(!unit_of_issue_abbrev) Then
flag = 1
lineout = &quot;Missing unit_of_issue_abbrev&quot;
.Edit
!unit_of_issue_abbrev = &quot;Null&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;unit_of_issue_full_name&quot; Then
If IsNull(!unit_of_issue_full_name) Then
flag = 1
lineout = &quot;Missing unit_of_issue_full_name&quot;
.Edit
!unit_of_issue_full_name = &quot;Null&quot;
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;Price_final&quot; Then
If IsNull(!price_final) Or !price_final = 0 Then
flag = 1
lineout = &quot;Missing price&quot;
!price_final = 0
GoSub 100
End If
End If

If rcd.Fields(x).name = &quot;UPC&quot; Then
If IsNull(!upc) Then
.Edit
!upc = !sim
.Update
Else
If !upc <> !sim Then
flag = 1
lineout = &quot;WARNING - UPC does not match SIM&quot;
GoSub 100
End If
End If
End If

If rcd.Fields(x).name = &quot;Short_Description&quot; Then
If IsNull(!short_description) Then
flag = 1
lineout = &quot;Short_Description missing&quot;
!short_description = &quot;Null&quot;
GoSub 100
Else
sstr = !short_description
If InStr(1, sstr, &quot;*&quot Then
flag = 1
lineout = &quot;WARNING - Errors in Short_Description&quot;
GoSub 100
End If
End If
End If
Next x
nflag = 0
counter = counter + 1
.MoveNext

Wend

End With

100 If flag = 1 Then
rcd2.AddNew
rcd2!sim = rcd!sim
rcd2![field name] = rcd.Fields(x).name
rcd2![Invalid data] = rcd.Fields(x)
rcd2![Error condition] = lineout
rcd2.Update
flag = 0
Return
End If

End Function

 

[rewdee]

Sorry Ballizz but this is way too much code for me (maybe some other reader will patiently and thoroughly go through it all but not me). Can you be a little more precise and simplify the problem (ie. why are you doing this routine)?

Rewdee

 

[ballizz]

Sorry... was in a hurry, didn't notice... Basically, making a log table for errors found on a main table, verifying some of the fields on the main table through repeated SQL use of a temp query, and populating the error table with an ID, field error found in, data in field, and short description of error...by removing extraneous Sets, Closes, and Refreshes, got the process to run to 4300 records as opposed to 2100 - problem is that main table contains 54000 records... hope this helps, thanks...

 

[ballizz]

Problem resolved - used a 'false' query by:
Set qry = CurrentDb.CreateQueryDef(&quot;&quot
With qry
.SQL = &quot;
...

This is treated as a JET operation and not a DAO, therefore not adding to the size of the db...