Access 2003 stops running with out of memory, but memory is there!

G

Guest

I have written some VBA code in a adp in access using a SQL2K database. The
code runs mostly SQL statements using the '.execute' command. There are
several loops in the code which also use some recordsets in the data.

The code runs fine on my machine, taking about 15 mins to run. However when
i pass it to my colleague (who has the same amount of memory but a slower
processer) then it stops running half way through claiming to be out of
memory; other programs still can be used at this point but Access can not,
closing and reopening access does not free the memory. Both machines are
running Access 2003.

What can i do to free the memory in Access after each loop of the program,
or is there a setting that must be different between machines, or any other
suggestions would be helpful
 
G

Guest

You said that you are using recordset with loops. I didn't see your code but
it seems that you might create object everytime it loops. I suggest you to
double check if there is multiple declaration in your code. Then, to be sure
nothing stay "alive" after your loops, use this on your object : Set
MyRecordSet = nothing

If you give us some code exemple, it should help to find what's wrong.
 
G

Guest

Thanks for reply, below is the code that creats the issue. I have removed
several parts of SQL code which are sensitive.

I have altered the code since the previous post, however it still seems not
to work

NB there are several lines which are commented with '

Thanks again
Barney

------
Public Sub Profile_Click()

On Error GoTo err1

Dim CON As ADODB.Connection
'Dim rstPROFILE As New ADODB.Recordset
'Dim rstPROFILEANALYSIS As New ADODB.Recordset
'Dim rstPROFILESUMMARY As New ADODB.Recordset
'Dim rstPROFILEDESPATCH As New ADODB.Recordset
Dim rstGROUPING As New ADODB.Recordset
Dim i As Integer
Dim a As Double
Dim b As Double
Dim TOT As Double
Dim tot2 As Double
Dim STEP As Integer
Dim COUNT As Integer
Dim GROUPSTEP As Integer
Dim strGROUPING As String


Set CON = CurrentProject.Connection
CON.CommandTimeout = 0

'this imput box is hidden and set to 17, however this check is left in
'17 is considered to be the appropraite length of checking
If Form_control!cycles = "" Or Form_control!cycles < 1 Or
IsNull(Form_control!cycles) = True Then
MsgBox "Incorrect number of cycles"
Exit Sub
End If


'update metre
SysCmd acSysCmdInitMeter, "Building", Form_control!cycles
SysCmd acSysCmdUpdateMeter, 0

COUNT = 0
GROUPSTEP = 0

'copy data out of the summary table, to a temp table. this data is the
selcted back to the summary table for analysis
'based on the later selection by grouping
If Form_control!by_range = True Or Form_control!by_category = True Or
Form_control!by_week Then
CON.Execute "delete tbl_summary_temp", , adExecuteNoRecords
CON.Execute "insert into tbl_summary_temp select * from tbl_summary", ,
adExecuteNoRecords
CON.Execute "delete tbl_summary", , adExecuteNoRecords
End If

'delete old results table
CON.Execute "delete tbl_despatch_profile_grouped", , adExecuteNoRecords

'build new grouping table based on the selection used
If Form_control!by_range = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select range from tbl_summary_temp
group by range order by range", , adExecuteNoRecords
End If

If Form_control!by_category = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select category from tbl_summary_temp
group by category order by category", , adExecuteNoRecords
End If

If Form_control!by_week = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select data_week from tbl_summary_temp
group by data_week order by data_week", , adExecuteNoRecords
End If

If Form_control!by_all = True Then GoTo skipgrouping

'to be able to analysis the correct data, based on the grouping value then
the data is moved back to the summary table
'based on a selection of thed grouping table, this is done by selecting data
'grouping' by 'grouping'
rstGROUPING.Open "tbl_grouping", CON, adOpenKeyset, adLockOptimistic
rstGROUPING.MoveFirst

'do the analysis for all datasets for each grouping value
Do Until rstGROUPING.EOF

GROUPSTEP = GROUPSTEP + 1

skipgrouping:


'select data set based on grouping value
If Form_control!by_range = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
range = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

If Form_control!by_category = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
category = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

If Form_control!by_week = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
data_week = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

'drop the old analysis table
CON.Execute "delete tbl_profile_summary", , adExecuteNoRecords

'build order book analysis table and tidy
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "drop table temp_profile_summary", , adExecuteNoRecords
CON.Execute "delete tbl_profile_analysis", , adExecuteNoRecords

'trap where there is not data in profile
If DSum("value", "tbl_profile_summary") = 0 Then
COUNT = COUNT + 1
GoTo skiptonew2
End If

'build %analysis of order analysis table
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords


'reset profile to 0
CON.Execute "update tbl_profile set [value] = 0", , adExecuteNoRecords

'populate current orders
CON.Execute "update tbl_profile set tbl_profile.[value] =
tbl_profile_summary.value from tbl_profile inner join tbl_profile_summary on
tbl_profile.year_week_var = tbl_profile_summary.year_week and
tbl_profile.measure = tbl_profile_summary.measure where tbl_profile.measure =
'orders'", , adExecuteNoRecords


'open connections
'rstprofile.open "tbl_profile",con,adopenkeyset,adlockoptimistic
'rstPROFILEANALYSIS.Open "tbl_profile_analysis", CON, adOpenKeyset,
adLockOptimistic
'rstPROFILESUMMARY.Open "tbl_profile_summary", CON, adOpenKeyset,
adLockOptimistic
'rstPROFILEDESPATCH.Open "tbl_despatch_profile", CON, adOpenKeyset,
adLockOptimistic

'trap where there is not data in profile
If DSum("value", "tbl_profile", "measure = 'orders' and year_week_int is not
null") = 0 Then
COUNT = COUNT + 1
GoTo skiptonew
End If


'clear DESPATCH profile
CON.Execute "update tbl_despatch_profile set value = 0, [percent] = 0", ,
adExecuteNoRecords
'rstPROFILEDESPATCH.MoveFirst
'Do Until rstPROFILEDESPATCH.EOF
'rstPROFILEDESPATCH!value = 0
'rstPROFILEDESPATCH!percent = 0
'rstPROFILEDESPATCH.MoveNext
'Loop

'check that the process is run for the correct number of cycles (default is
17)
STEP = 0
Do Until STEP = Form_control!cycles + 1

'update metre
If Form_control!by_all = False Then
SysCmd acSysCmdInitMeter, "Building (" & GROUPSTEP & " of " &
DCount("grouping", "tbl_grouping") & ") " & rstGROUPING!grouping,
Form_control!cycles
SysCmd acSysCmdUpdateMeter, STEP
Else
SysCmd acSysCmdInitMeter, "Building all", Form_control!cycles
SysCmd acSysCmdUpdateMeter, STEP
End If

'below are the analyis steps whcih calculate the values coming in and out of
the order book,
'these are done in part groups

'what is being taken 'out'
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "select * into tbl_temp3 from tbl_profile where measure =
'orders'", , adExecuteNoRecords

CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "drop table tbl_temp3", , adExecuteNoRecords


''def in'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here",
,adExecuteNoRecords


''bf in'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords


''uncon in'
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "i have removed sensitive SQL code from here",, adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords



''holding'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords

'calculate despatches and add to the results table for this grouping
CON.Execute "update tbl_despatch_profile set tbl_despatch_profile.value =
(select sum(value) as value from tbl_profile where tbl_profile.year_week_var
= '0') where tbl_despatch_profile.year_week = '" & STEP & "'", ,
adExecuteNoRecords

CON.Execute "dbcc freeproccache", , adExecuteNoRecords

'calculate the new order profile based on the values of items coming 'in'
and 'out'
i = 1
Do Until i = 40

TOT = DSum("value", "tbl_profile", "year_week_int = " & i)

'the new orders profile is 'shifted' up by one week
'rstPROFILE.MoveFirst
'Do Until rstPROFILE.EOF
'If rstPROFILE!measure = "orders" And rstPROFILE!year_week_int = i - 1 Then
'rstPROFILE!value = TOT
'rstPROFILE.Update
'End If
'rstPROFILE.MoveNext
'Loop

CON.Execute "update tbl_profile set value = " & TOT & " where year_week_int
= " & i - 1 & " and measure = 'orders'", , adExecuteNoRecords

i = i + 1
Loop


STEP = STEP + 1

If Form_control!by_all = False Then
strGROUPING = rstGROUPING!grouping
End If

CON.close
Set CON = Nothing

Set CON = CurrentProject.Connection
CON.CommandTimeout = 0


If Form_control!by_all = False Then
rstGROUPING.Open "tbl_grouping", CON, adOpenKeyset, adLockOptimistic
rstGROUPING.MoveFirst
rstGROUPING.Find "grouping = '" & strGROUPING & "'", 0, adSearchForward, 0
End If



Loop

'update percentage of results
If DSum("value", "tbl_despatch_profile") <> 0 Then
CON.Execute "update tbl_despatch_profile set tbl_despatch_profile.[percent]
= [value] / (select sum([value]) as [value] from tbl_despatch_profile) from
tbl_despatch_profile", , adExecuteNoRecords
End If

'set weeks_used if not 0
If DSum("value", "tbl_despatch_profile") <> 0 Then
CON.Execute "update tbl_despatch_profile set tbl_despatch_profile.weeks_used
= (select max(year_week) from tbl_despatch_profile where value <> 0)", ,
adExecuteNoRecords
End If

'set weeks_used if 0
If DSum("value", "tbl_despatch_profile") = 0 Then
CON.Execute "update tbl_despatch_profile set tbl_despatch_profile.weeks_used
= 0", , adExecuteNoRecords
End If


'copy to grouped output for 'all'
If Form_control!by_all = True Then
CON.Execute "insert into tbl_despatch_profile_grouped select 'all' as
grouping, * from tbl_despatch_profile where tbl_despatch_profile.year_week <=
tbl_despatch_profile.weeks_used", , adExecuteNoRecords
GoTo exit_loop
End If

'copy to group output for other
CON.Execute "insert into tbl_despatch_profile_grouped select '" &
rstGROUPING!grouping & "' as grouping, * from tbl_despatch_profile where
year_week <= weeks_used", , adExecuteNoRecords

skiptonew:

'rstprofile.close
'rstPROFILEANALYSIS.close
'rstPROFILESUMMARY.close
'rstPROFILEDESPATCH.close

skiptonew2:

rstGROUPING.MoveNext
CON.Execute "delete tbl_summary", , adExecuteNoRecords

SysCmd acSysCmdUpdateMeter, 0
Loop

'delete summary table and copy back the whole data set
CON.Execute "delete tbl_summary", , adExecuteNoRecords
CON.Execute "insert into tbl_summary select * from tbl_summary_temp", ,
adExecuteNoRecords

exit_loop:

'set weeks_used to + 1 to accommodate week 0
CON.Execute "update tbl_despatch_profile_grouped set
tbl_despatch_profile_grouped.weeks_used =
tbl_despatch_profile_grouped.weeks_used + 1", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped set
tbl_despatch_profile_grouped.year_week =
tbl_despatch_profile_grouped.year_week + 1", , adExecuteNoRecords

'make numbers a rounded %
CON.Execute "update tbl_despatch_profile_grouped set
tbl_despatch_profile_grouped.[percent] =
round((tbl_despatch_profile_grouped.[percent]*100),2)", , adExecuteNoRecords

'transpose output
'build table
CON.Execute "delete tbl_despatch_profile_grouped_trans", , adExecuteNoRecords
CON.Execute "insert into tbl_despatch_profile_grouped_trans select grouping,
cast(0 as float) as MFI_WK1, cast(0 as float) as MFI_WK2, cast(0 as float)
as MFI_WK3, cast(0 as float) as MFI_WK4, cast(0 as float) as MFI_WK5, cast(0
as float) as MFI_WK6, cast(0 as float) as MFI_WK7, cast(0 as float) as
MFI_WK8, cast(0 as float) as MFI_WK9, cast(0 as float) as MFI_WK10, cast(0 as
float) as MFI_WK11, cast(0 as float) as MFI_WK12, cast(0 as float) as
MFI_WK13, cast(0 as float) as MFI_WK14, cast(0 as float) as MFI_WK15, cast(0
as float) as MFI_WK16, cast(0 as float) as MFI_WK17, cast(0 as float) as
MFI_WK18, 0 as MFI_NUM_WEEKS from tbl_despatch_profile_grouped group by
grouping ", , adExecuteNoRecords

CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK1 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 1", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK2 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 2", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK3 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 3", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK4 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 4", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK5 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 5", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK6 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 6", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK7 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 7", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK8 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 8", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK9 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 9", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK10 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 10", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK11 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 11", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK12 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 12", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK13 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 13", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK14 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 14", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK15 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 15", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK16 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 16", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK17 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 17", , adExecuteNoRecords
CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_WK18 =
tbl_despatch_profile_grouped.[percent] from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 18", , adExecuteNoRecords

CON.Execute "update tbl_despatch_profile_grouped_trans set MFI_NUM_WEEKS =
tbl_despatch_profile_grouped.weeks_used from tbl_despatch_profile_grouped
inner join tbl_despatch_profile_grouped_trans on
tbl_despatch_profile_grouped.grouping =
tbl_despatch_profile_grouped_trans.grouping where
tbl_despatch_profile_grouped.year_week = 1", , adExecuteNoRecords


SysCmd acSysCmdRemoveMeter

If Form_control!check = 0 Then
MsgBox ("Done with " & COUNT & " profile(s) skipped due to no data")
End If

CON.close

err_exit:
Exit Sub
err1:
MsgBox err.Description
GoTo err_exit


End Sub
 
G

Guest

I came across your code and I see nothing obvious. I think it will be an
added value for you to split your code in many function instead of only one
sub.

It will be easier to read/understand and for debug matter it is simpler to
search what’s wrong in 10 lines then in 100 lines.

Did you try to put a breakpoint to see if it is always stop at the same
place or if it crashes random?

Barney said:
Thanks for reply, below is the code that creats the issue. I have removed
several parts of SQL code which are sensitive.

I have altered the code since the previous post, however it still seems not
to work

NB there are several lines which are commented with '

Thanks again
Barney

------
Public Sub Profile_Click()

On Error GoTo err1

Dim CON As ADODB.Connection
'Dim rstPROFILE As New ADODB.Recordset
'Dim rstPROFILEANALYSIS As New ADODB.Recordset
'Dim rstPROFILESUMMARY As New ADODB.Recordset
'Dim rstPROFILEDESPATCH As New ADODB.Recordset
Dim rstGROUPING As New ADODB.Recordset
Dim i As Integer
Dim a As Double
Dim b As Double
Dim TOT As Double
Dim tot2 As Double
Dim STEP As Integer
Dim COUNT As Integer
Dim GROUPSTEP As Integer
Dim strGROUPING As String


Set CON = CurrentProject.Connection
CON.CommandTimeout = 0

'this imput box is hidden and set to 17, however this check is left in
'17 is considered to be the appropraite length of checking
If Form_control!cycles = "" Or Form_control!cycles < 1 Or
IsNull(Form_control!cycles) = True Then
MsgBox "Incorrect number of cycles"
Exit Sub
End If


'update metre
SysCmd acSysCmdInitMeter, "Building", Form_control!cycles
SysCmd acSysCmdUpdateMeter, 0

COUNT = 0
GROUPSTEP = 0

'copy data out of the summary table, to a temp table. this data is the
selcted back to the summary table for analysis
'based on the later selection by grouping
If Form_control!by_range = True Or Form_control!by_category = True Or
Form_control!by_week Then
CON.Execute "delete tbl_summary_temp", , adExecuteNoRecords
CON.Execute "insert into tbl_summary_temp select * from tbl_summary", ,
adExecuteNoRecords
CON.Execute "delete tbl_summary", , adExecuteNoRecords
End If

'delete old results table
CON.Execute "delete tbl_despatch_profile_grouped", , adExecuteNoRecords

'build new grouping table based on the selection used
If Form_control!by_range = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select range from tbl_summary_temp
group by range order by range", , adExecuteNoRecords
End If

If Form_control!by_category = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select category from tbl_summary_temp
group by category order by category", , adExecuteNoRecords
End If

If Form_control!by_week = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select data_week from tbl_summary_temp
group by data_week order by data_week", , adExecuteNoRecords
End If

If Form_control!by_all = True Then GoTo skipgrouping

'to be able to analysis the correct data, based on the grouping value then
the data is moved back to the summary table
'based on a selection of thed grouping table, this is done by selecting data
'grouping' by 'grouping'
rstGROUPING.Open "tbl_grouping", CON, adOpenKeyset, adLockOptimistic
rstGROUPING.MoveFirst

'do the analysis for all datasets for each grouping value
Do Until rstGROUPING.EOF

GROUPSTEP = GROUPSTEP + 1

skipgrouping:


'select data set based on grouping value
If Form_control!by_range = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
range = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

If Form_control!by_category = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
category = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

If Form_control!by_week = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
data_week = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

'drop the old analysis table
CON.Execute "delete tbl_profile_summary", , adExecuteNoRecords

'build order book analysis table and tidy
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "drop table temp_profile_summary", , adExecuteNoRecords
CON.Execute "delete tbl_profile_analysis", , adExecuteNoRecords

'trap where there is not data in profile
If DSum("value", "tbl_profile_summary") = 0 Then
COUNT = COUNT + 1
GoTo skiptonew2
End If

'build %analysis of order analysis table
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords


'reset profile to 0
CON.Execute "update tbl_profile set [value] = 0", , adExecuteNoRecords

'populate current orders
CON.Execute "update tbl_profile set tbl_profile.[value] =
tbl_profile_summary.value from tbl_profile inner join tbl_profile_summary on
tbl_profile.year_week_var = tbl_profile_summary.year_week and
tbl_profile.measure = tbl_profile_summary.measure where tbl_profile.measure =
'orders'", , adExecuteNoRecords


'open connections
'rstprofile.open "tbl_profile",con,adopenkeyset,adlockoptimistic
'rstPROFILEANALYSIS.Open "tbl_profile_analysis", CON, adOpenKeyset,
adLockOptimistic
'rstPROFILESUMMARY.Open "tbl_profile_summary", CON, adOpenKeyset,
adLockOptimistic
'rstPROFILEDESPATCH.Open "tbl_despatch_profile", CON, adOpenKeyset,
adLockOptimistic

'trap where there is not data in profile
If DSum("value", "tbl_profile", "measure = 'orders' and year_week_int is not
null") = 0 Then
COUNT = COUNT + 1
GoTo skiptonew
End If


'clear DESPATCH profile
CON.Execute "update tbl_despatch_profile set value = 0, [percent] = 0", ,
adExecuteNoRecords
'rstPROFILEDESPATCH.MoveFirst
'Do Until rstPROFILEDESPATCH.EOF
'rstPROFILEDESPATCH!value = 0
'rstPROFILEDESPATCH!percent = 0
'rstPROFILEDESPATCH.MoveNext
'Loop

'check that the process is run for the correct number of cycles (default is
17)
STEP = 0
Do Until STEP = Form_control!cycles + 1

'update metre
If Form_control!by_all = False Then
SysCmd acSysCmdInitMeter, "Building (" & GROUPSTEP & " of " &
DCount("grouping", "tbl_grouping") & ") " & rstGROUPING!grouping,
Form_control!cycles
SysCmd acSysCmdUpdateMeter, STEP
Else
SysCmd acSysCmdInitMeter, "Building all", Form_control!cycles
SysCmd acSysCmdUpdateMeter, STEP
End If

'below are the analyis steps whcih calculate the values coming in and out of
the order book,
'these are done in part groups

'what is being taken 'out'
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "select * into tbl_temp3 from tbl_profile where measure =
'orders'", , adExecuteNoRecords

CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "drop table tbl_temp3", , adExecuteNoRecords


''def in'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here",
,adExecuteNoRecords


''bf in'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords


''uncon in'
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "i have removed sensitive SQL code from here",, adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords



''holding'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords

'calculate despatches and add to the results table for this grouping
CON.Execute "update tbl_despatch_profile set tbl_despatch_profile.value =
(select sum(value) as value from tbl_profile where tbl_profile.year_week_var
= '0') where tbl_despatch_profile.year_week = '" & STEP & "'", ,
adExecuteNoRecords

CON.Execute "dbcc freeproccache", , adExecuteNoRecords

'calculate the new order profile based on the values of items coming 'in'
and 'out'
i = 1
Do Until i = 40

TOT = DSum("value", "tbl_profile", "year_week_int = " & i)

'the new orders profile is 'shifted' up by one week
'rstPROFILE.MoveFirst
'Do Until rstPROFILE.EOF
'If rstPROFILE!measure = "orders" And rstPROFILE!year_week_int = i - 1 Then
'rstPROFILE!value = TOT
'rstPROFILE.Update
'End If
'rstPROFILE.MoveNext
'Loop

CON.Execute "update tbl_profile set value = " & TOT & " where year_week_int
= " & i - 1 & " and measure = 'orders'", , adExecuteNoRecords

i = i + 1
Loop


STEP = STEP + 1

If Form_control!by_all = False Then
strGROUPING = rstGROUPING!grouping
End If
Click to expand...
 
G

Guest

what is apparently happening is that the code gets half way through and then
slows to an absolute crawl in the main central loop section. Only when you
try to interrupt and debug the code (to see where it is) does it fail with
'unexpected error' and 'out of memory'



Yanick said:
I came across your code and I see nothing obvious. I think it will be an
added value for you to split your code in many function instead of only one
sub.

It will be easier to read/understand and for debug matter it is simpler to
search what’s wrong in 10 lines then in 100 lines.

Did you try to put a breakpoint to see if it is always stop at the same
place or if it crashes random?

Barney said:
Thanks for reply, below is the code that creats the issue. I have removed
several parts of SQL code which are sensitive.

I have altered the code since the previous post, however it still seems not
to work

NB there are several lines which are commented with '

Thanks again
Barney

------
Public Sub Profile_Click()

On Error GoTo err1

Dim CON As ADODB.Connection
'Dim rstPROFILE As New ADODB.Recordset
'Dim rstPROFILEANALYSIS As New ADODB.Recordset
'Dim rstPROFILESUMMARY As New ADODB.Recordset
'Dim rstPROFILEDESPATCH As New ADODB.Recordset
Dim rstGROUPING As New ADODB.Recordset
Dim i As Integer
Dim a As Double
Dim b As Double
Dim TOT As Double
Dim tot2 As Double
Dim STEP As Integer
Dim COUNT As Integer
Dim GROUPSTEP As Integer
Dim strGROUPING As String


Set CON = CurrentProject.Connection
CON.CommandTimeout = 0

'this imput box is hidden and set to 17, however this check is left in
'17 is considered to be the appropraite length of checking
If Form_control!cycles = "" Or Form_control!cycles < 1 Or
IsNull(Form_control!cycles) = True Then
MsgBox "Incorrect number of cycles"
Exit Sub
End If


'update metre
SysCmd acSysCmdInitMeter, "Building", Form_control!cycles
SysCmd acSysCmdUpdateMeter, 0

COUNT = 0
GROUPSTEP = 0

'copy data out of the summary table, to a temp table. this data is the
selcted back to the summary table for analysis
'based on the later selection by grouping
If Form_control!by_range = True Or Form_control!by_category = True Or
Form_control!by_week Then
CON.Execute "delete tbl_summary_temp", , adExecuteNoRecords
CON.Execute "insert into tbl_summary_temp select * from tbl_summary", ,
adExecuteNoRecords
CON.Execute "delete tbl_summary", , adExecuteNoRecords
End If

'delete old results table
CON.Execute "delete tbl_despatch_profile_grouped", , adExecuteNoRecords

'build new grouping table based on the selection used
If Form_control!by_range = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select range from tbl_summary_temp
group by range order by range", , adExecuteNoRecords
End If

If Form_control!by_category = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select category from tbl_summary_temp
group by category order by category", , adExecuteNoRecords
End If

If Form_control!by_week = True Then
CON.Execute "delete tbl_grouping", , adExecuteNoRecords
CON.Execute "insert into tbl_grouping select data_week from tbl_summary_temp
group by data_week order by data_week", , adExecuteNoRecords
End If

If Form_control!by_all = True Then GoTo skipgrouping

'to be able to analysis the correct data, based on the grouping value then
the data is moved back to the summary table
'based on a selection of thed grouping table, this is done by selecting data
'grouping' by 'grouping'
rstGROUPING.Open "tbl_grouping", CON, adOpenKeyset, adLockOptimistic
rstGROUPING.MoveFirst

'do the analysis for all datasets for each grouping value
Do Until rstGROUPING.EOF

GROUPSTEP = GROUPSTEP + 1

skipgrouping:


'select data set based on grouping value
If Form_control!by_range = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
range = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

If Form_control!by_category = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
category = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

If Form_control!by_week = True Then
CON.Execute "insert into tbl_summary select * from tbl_summary_temp where
data_week = '" & rstGROUPING!grouping & "'", , adExecuteNoRecords
End If

'drop the old analysis table
CON.Execute "delete tbl_profile_summary", , adExecuteNoRecords

'build order book analysis table and tidy
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "drop table temp_profile_summary", , adExecuteNoRecords
CON.Execute "delete tbl_profile_analysis", , adExecuteNoRecords

'trap where there is not data in profile
If DSum("value", "tbl_profile_summary") = 0 Then
COUNT = COUNT + 1
GoTo skiptonew2
End If

'build %analysis of order analysis table
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords


'reset profile to 0
CON.Execute "update tbl_profile set [value] = 0", , adExecuteNoRecords

'populate current orders
CON.Execute "update tbl_profile set tbl_profile.[value] =
tbl_profile_summary.value from tbl_profile inner join tbl_profile_summary on
tbl_profile.year_week_var = tbl_profile_summary.year_week and
tbl_profile.measure = tbl_profile_summary.measure where tbl_profile.measure =
'orders'", , adExecuteNoRecords


'open connections
'rstprofile.open "tbl_profile",con,adopenkeyset,adlockoptimistic
'rstPROFILEANALYSIS.Open "tbl_profile_analysis", CON, adOpenKeyset,
adLockOptimistic
'rstPROFILESUMMARY.Open "tbl_profile_summary", CON, adOpenKeyset,
adLockOptimistic
'rstPROFILEDESPATCH.Open "tbl_despatch_profile", CON, adOpenKeyset,
adLockOptimistic

'trap where there is not data in profile
If DSum("value", "tbl_profile", "measure = 'orders' and year_week_int is not
null") = 0 Then
COUNT = COUNT + 1
GoTo skiptonew
End If


'clear DESPATCH profile
CON.Execute "update tbl_despatch_profile set value = 0, [percent] = 0", ,
adExecuteNoRecords
'rstPROFILEDESPATCH.MoveFirst
'Do Until rstPROFILEDESPATCH.EOF
'rstPROFILEDESPATCH!value = 0
'rstPROFILEDESPATCH!percent = 0
'rstPROFILEDESPATCH.MoveNext
'Loop

'check that the process is run for the correct number of cycles (default is
17)
STEP = 0
Do Until STEP = Form_control!cycles + 1

'update metre
If Form_control!by_all = False Then
SysCmd acSysCmdInitMeter, "Building (" & GROUPSTEP & " of " &
DCount("grouping", "tbl_grouping") & ") " & rstGROUPING!grouping,
Form_control!cycles
SysCmd acSysCmdUpdateMeter, STEP
Else
SysCmd acSysCmdInitMeter, "Building all", Form_control!cycles
SysCmd acSysCmdUpdateMeter, STEP
End If

'below are the analyis steps whcih calculate the values coming in and out of
the order book,
'these are done in part groups

'what is being taken 'out'
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "select * into tbl_temp3 from tbl_profile where measure =
'orders'", , adExecuteNoRecords

CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "drop table tbl_temp3", , adExecuteNoRecords


''def in'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here",
,adExecuteNoRecords


''bf in'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords


''uncon in'
CON.Execute "i have removed sensitive SQL code from here", ,
adExecuteNoRecords

CON.Execute "i have removed sensitive SQL code from here",, adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords



''holding'
CON.Execute "i have removed sensitive SQL code from here ", ,
adExecuteNoRecords

CON.Execute " i have removed sensitive SQL code from here", ,
adExecuteNoRecords

'calculate despatches and add to the results table for this grouping
CON.Execute "update tbl_despatch_profile set tbl_despatch_profile.value =
(select sum(value) as value from tbl_profile where tbl_profile.year_week_var
= '0') where tbl_despatch_profile.year_week = '" & STEP & "'", ,
adExecuteNoRecords

CON.Execute "dbcc freeproccache", , adExecuteNoRecords

'calculate the new order profile based on the values of items coming 'in'
and 'out'
i = 1
Do Until i = 40

TOT = DSum("value", "tbl_profile", "year_week_int = " & i)

'the new orders profile is 'shifted' up by one week
'rstPROFILE.MoveFirst
'Do Until rstPROFILE.EOF
'If rstPROFILE!measure = "orders" And rstPROFILE!year_week_int = i - 1 Then
'rstPROFILE!value = TOT
'rstPROFILE.Update
'End If
'rstPROFILE.MoveNext
'Loop

CON.Execute "update tbl_profile set value = " & TOT & " where year_week_int
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Memory issue 8
Programming for query completeness 3
Out of memory exception not being thrown 3
Windows Photo Viewer can’t display this picture because there might not be enough memory available on your computer. 3
Kingston HyperX Genesis 2133MHz 16GB Memory Kit 0
run out of memory error 2004 on CreateWorkSpace command with Windo 5
Handling internet explorer memory leaks from Excel VBA 0
How to clear out of memory error? 1

Top