InstructionWhich7142
Registered User.
- Local time
- Today, 12:38
- Joined
- Feb 24, 2010
- Messages
- 206
i asked this last week:
http://www.access-programmers.co.uk/forums/showthread.php?t=188857
after a lot of searches and thinking i managed to write the below which almost achieves the aims, i have two small problems still:
first is that the line:
DoCmd.RunSQL "update orderstab Set deldate = #" & oldestdeldate & "# where speckey = '" & specordline & "';"
(10ish lines from the end of the code)
it writes the date value stored in "oldestdeldate" [stored as a date] as a text value instead (does the field it writes too need to be formatted as a date to fix this? or should access correct this if i can get the SQL to write it back correctly?)
the second is speed, looping through 2000 records takes a long time (10 mins?) what can i do to streamline this code?
is there a more elegant way to loop than calling it from a function over and over? also should i clear the variables at the end of every loop?
http://www.access-programmers.co.uk/forums/showthread.php?t=188857
after a lot of searches and thinking i managed to write the below which almost achieves the aims, i have two small problems still:
first is that the line:
DoCmd.RunSQL "update orderstab Set deldate = #" & oldestdeldate & "# where speckey = '" & specordline & "';"
(10ish lines from the end of the code)
it writes the date value stored in "oldestdeldate" [stored as a date] as a text value instead (does the field it writes too need to be formatted as a date to fix this? or should access correct this if i can get the SQL to write it back correctly?)
the second is speed, looping through 2000 records takes a long time (10 mins?) what can i do to streamline this code?
is there a more elegant way to loop than calling it from a function over and over? also should i clear the variables at the end of every loop?
Code:
Option Compare Database
Option Explicit
Function matchlinescall()
Do
If DCount("speckey", "orderstab", "sumofqty > 0") <> 0 Then
Call lineref
Else
Exit Function
End If
Loop
End Function
Sub lineref()
'#no confirmations
DoCmd.SetWarnings False
'# Order line number as a key
Dim linerefvar As String
'# earliest date of orders table
Dim oldestreqdate As Date
'# specific line of orders table
Dim specordline As String
'# oldest delivery date
Dim oldestdeldate As Date
'# specific line on deliveries table
Dim specdelline As String
'# quantity that was delivered
Dim specdelqty As Integer
'# quantity that was ordered on that line
Dim specordqty As Integer
'# product of the two
Dim qtyresult As Integer
'# not negative result
Dim notnegresult As Integer
'# po & line to work on:
linerefvar = DLookup("key", "orderstab", "sumofqty > 0")
'MsgBox linerefvar
'# schedule line to work on:
oldestreqdate = DLookup("min([reqdate])", "orderstab", "key = '" & linerefvar & "' And sumofqty > 0")
'MsgBox oldestreqdate
specordline = DLookup("speckey", "orderstab", "key = '" & linerefvar & "' And reqdate = #" & Format(oldestreqdate, "mm/dd/yyyy") & "#")
'MsgBox specordline
'# delivery line to work on:
If (DCount("speckey", "delstab", "key = '" & linerefvar & "' And sumofbqty > 0")) = 0 Then
DoCmd.RunSQL "update orderstab Set deldate = 'not delivered' where speckey = '" & specordline & "';"
DoCmd.RunSQL "update orderstab set sumofqty = 0 where speckey = '" & specordline & "';"
Exit Sub
End If
oldestdeldate = DLookup("min([deldate])", "delstab", "key = '" & linerefvar & "' And sumofbqty > 0")
'MsgBox oldestdeldate
specdelline = DLookup("speckey", "delstab", "key = '" & linerefvar & "' And deldate = #" & Format(oldestdeldate, "mm/dd/yyyy") & "#")
'MsgBox specdelline
specdelqty = DLookup("sumofbqty", "delstab", "speckey = '" & specdelline & "'")
'MsgBox specdelqty
specordqty = DLookup("sumofqty", "orderstab", "speckey = '" & specordline & "'")
'MsgBox specordqty
qtyresult = specordqty - specdelqty
'MsgBox qtyresult
If qtyresult <= 0 Then
DoCmd.RunSQL "update orderstab Set deldate = #" & oldestdeldate & "# where speckey = '" & specordline & "';"
End If
notnegresult = qtyresult * -1
'MsgBox notnegresult
If qtyresult < 0 Then
DoCmd.RunSQL "update delstab set sumofbqty = '" & notnegresult & "' where speckey = '" & specdelline & "';"
DoCmd.RunSQL "update orderstab set sumofqty = 0 where speckey = '" & specordline & "';"
Else
DoCmd.RunSQL "update orderstab set sumofqty = '" & qtyresult & "' where speckey = '" & specordline & "';"
DoCmd.RunSQL "update delstab set sumofbqty = 0 where speckey = '" & specdelline & "';"
End If
Exit Sub
'# warnings on again
DoCmd.SetWarnings True
End Sub