speed up vba data analysis function

[Rob Hick]

Hi all,

I was wondering whether anyone could advise me on speeding up the
following vba function. It calculates the number of days an amount of
stock would last if the inventory depletes by an average amount each
successive day. I've used an iterative procedure which reduces a
value by succesive amounts from a separate table and counts the number
of iterations until the value is less than zero. It will return a
value something like 10.45. It doesn't run terribly slowly but i
think it could be speeded up if i wasn't opening a new recordset for
the average values every time a new value is calculated. The function
will eventually be used to calculate values for 9 products per day so
the quicker the better. Function follows:



Public Function LiteralStockCover(TotalStock As Double, ByVal
BloodGroup As String, ByVal ProductGroupID As Integer, ByVal StockDate
As Date) As Single

Dim db As Database, rst As Recordset, strSQL As String, RunningTotal
As Double, LSC As Single, DayCount As Integer, _
sysJumpOut As Integer, IssueMonth As Variant, IssueDay As
Integer

On Error GoTo Err_Cleanup

IssueMonth = Format(StockDate, "yyyymm")
IssueDay = WeekDay(StockDate)
strSQL = "SELECT IssueDay, c" & BloodGroup & " FROM tbl_NominalLSC
" _
& "WHERE Month = " & IssueMonth & " AND
ProductGroupID=" & ProductGroupID
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot, dbDenyWrite,
dbOptimistic)

sysJumpOut = 0
RunningTotal = TotalStock
DayCount = IssueDay

Do Until sysJumpOut = 1

rst.FindFirst "IssueDay = " & DayCount
If rst.NoMatch = True Then
MsgBox "no match - problem"
GoTo Err_Cleanup
End If

RunningTotal = RunningTotal - rst(1).Value
If RunningTotal >= 0 Then
LSC = LSC + 1
DayCount = DayCount + 1
If DayCount > 7 Then: DayCount = 1
Else
LSC = LSC + ((RunningTotal / rst(1).Value) + 1)
sysJumpOut = 1
End If

Loop

LiteralStockCover = LSC

Err_Cleanup:
If Err Then: MsgBox Err.Description
Set db = Nothing
Set rst = Nothing



End Function

Any help greatly appreciated
Rob

 

[Tim Ferguson]

(e-mail address removed) (Rob Hick) wrote in

It calculates the number of days an amount of
stock would last if the inventory depletes by an average amount each
successive day

I'll take your word for it, but there is a lot of code here without a
single comment. Just as a matter of interest, how do you plan to read this
in eighteen months time, or, worse, how do you plan for your successor to
read it?

Just to save you some work, I've reformatted it into generally human-
readable form, but I still don't have clue what it is meant to be doing.
There are some obvious problems, however.

Public Function LiteralStockCover( _
TotalStock As Double, _
ByVal BloodGroup As String, _
ByVal ProductGroupID As Integer, _
ByVal StockDate As Date) As Single

Dim db As Database
Dim rst As Recordset
Dim strSQL As String
Dim RunningTotal As Double
Dim LSC As Single
Dim DayCount As Integer

' don't know what the significance of sys as a prefix is: does
' it matter?
Dim sysJumpOut As Integer

' this seems to be used as a string later on: does
' that matter?
Dim IssueMonth As Variant
Dim IssueDay As Integer

On Error GoTo Err_Cleanup

IssueMonth = Format(StockDate, "yyyymm")
IssueDay = WeekDay(StockDate)

'
' there are hints in this query of a major design issue: if
' you have columns like cOPlus, cONeg, cAPlus, cBPlus etc
' then you should be looking at normalising the design
'
' Since IssueMonth is a string like "200305", then it should be
' in quotes - please don't tell me that you have coded it as a
' numeric..
'
strSQL = "SELECT IssueDay, c" & BloodGroup & " " & _
"FROM tbl_NominalLSC" & _
"WHERE Month = " & IssueMonth & " " & _
" AND ProductGroupID = " & ProductGroupID & ";"

Set db = CurrentDb()

' Snapshot is fine here, but a ForwardOnly would be quicker,
' since you are trying to go for speed. On the same subject
' you might like to think about using a compiled query (e.g.
' storing it as a querydef) with parameters. Won't save a
' lot of time, but it's easier to debug too...
'
Set rst = db.OpenRecordset( _
strSQL, dbOpenSnapshot, dbDenyWrite, dbOptimistic)

sysJumpOut = 0
RunningTotal = TotalStock
DayCount = IssueDay

Do Until sysJumpOut = 1

' this seems to be the only record you are
' looking for -- why not put this criterion in the
' query?
' Actually, it appears that you are only using one
' value from the entire recordset, so you might as
' well just use a DLookUp and save a mountain of
' heartache.
'
rst.FindFirst "IssueDay = " & DayCount
If rst.NoMatch = True Then
MsgBox "no match - problem"
GoTo Err_Cleanup
End If

' the rst(1) is presumably the "c"&BloodGroup column;
' so it would help to put that here
RunningTotal = RunningTotal - rst(1).Value

' Can't help with this stuff
If RunningTotal >= 0 Then
LSC = LSC + 1

' this can be shorted using a Mod function
DayCount = DayCount + 1
If DayCount > 7 Then
DayCount = 1

End If

Else
LSC = LSC + ((RunningTotal / rst(1).Value) + 1)
sysJumpOut = 1

End If

Loop

LiteralStockCover = LSC

Err_Cleanup:
If Err Then
MsgBox Err.Description
End If

' better to put this after closing the recordset
Set db = Nothing

' you haven't closed the recordset yet...
Set rst = Nothing

End Function


Sorry that this is just pecking about the details, but it's not possible to
comment on an algorithm without knowing what the algorithm is. On the face
of it, what you described sounded like a simple exponential decay, but I
don't know how that relates to the code you posted.


All the best


Tim F

 

[HSalim]

I have not read your code. As Tim pointed out, it is tough to understand
and Tim has some valuable points for you to consider.
Anyway, why would you want to use a recordset to simulate the depletion?

Here is the pseudo-code of the approach:
Get average utilization - You can calcuate that by a simple SQL statement.
For example select Avg(usage) from sometable where trandate between
startdate and enddae

Get current inventory on hand - now this could be a calculation again, or
you nay have a
currentQuantity on hand available somewhere

Days remaining = inventoryonhand/Averageusage

HS

 

[TC]

Hey, let me jump in here too!



(snip)

strSQL = "SELECT IssueDay, c" & BloodGroup & " FROM ... etc. then about 20 lines later:
RunningTotal = RunningTotal - rst(1).Value

rst(1) is not good here. It means, "the second field that I listed in the
SELECT statement 20 lines before!". If you re-ordered the fields in the
SELECT statement (or added some to the start), you'd have to remember to
change the rst(1).

Far better to just say:

rst![c]

or:

rst("c")

Those versions use the field *name* to reference the field, independent of
its position in the SELECT statement. (And you can omit '.Value', since that
is the default property for a recordset field reference.)

HTH,
TC

 

[Rob Hick]

Thanks for your interest fellas, sorry for the poor state of my first
post. The reason there was no comments added is primarily because I'm
lazy and secondly because most of the functions I write are for
analysis purposes using data that i am excessively familiar with so
can tell what everything means just by a quick look through -
ovbiously this is no help to you so I'll try again. I've tried to be
as thorough as possible with the comments (posted below). First i'll
try and answer some of the initial questions:

"Major design issue" - I'm not sure what you mean by normalise but i
assume you mean putting the various columns (they're ABO Rh blood
groups (OPos, ONeg etc)) into 2 columns, 1 for label and another for
the value. I have inherited this data structure to a certain extent
and am therefore used to using it in this way. In many cases it helps
because i will want to do the same calculation on each column, e.g.
dividing one column by another from a different table. I could change
the format of the table using union queries if you think this would
help.

"Issue Month as string" - I've declared this as type variant purely
out of habit. I could declare as a string if you think this would
speed things up.

"using Mod function" - not familiar with this, how could i speed it
up?

"DLookup" - I am indeed only looking up one value to minus from the
RunningTotal (see below). I thought it would be quickest to open one
recordset and then step through the values i need rather that using a
DLookup to get each value. Am I wrong here?

"Exponential decay" - i think it's just linear decay but i could be
wrong. Is there a more mathematical wy to deal with this? I couldn't
think of one.

"Days remaining = inventoryonhand/Averageusage" - I have this
calculation already running. The calculation i'm using this function
for is to show the actual number of days cover we have if no more
blood is collected.

Thanks again for all your help.

Rob
code follows:

Public Function LiteralStockCover(TotalStock As Double, ByVal
BloodGroup As String, ByVal ProductGroupID As Integer, ByVal StockDate
As Date) As Single
'This function will calculate the number of days the a given stock
level will last in real-time days.
'Each day of the week has a calculated average issue and the function
will step through these values successively
'depending on the start day, until the Stock has dropped below zero.
'The final day is then calculated as a fraction to give the number of
days to the nearest 2 sig fig.

Dim db As Database 'will hold database reference
Dim rst As Recordset 'will hold record set reference
Dim strSQL As String 'will hold necessary SQL string
Dim RunningTotal As Double 'will store value of the Stock as function
steps through values and depletes the stock
Dim LSC As Single 'will hold the count of the days the
function has stepped through
Dim DayCount As Integer 'identifies next weekday
Dim flgJumpOut As Integer 'flag to stop the loop when the Stock has
dropped below zero
Dim IssueMonth As Variant 'the month that the Stock Date concerned
is in, in yyyymm format
Dim IssueDay As Integer 'the day of the week that is the initial
stock date

On Error GoTo Err_Cleanup
'set IssueMonth to the relevant month and format
IssueMonth = Format(StockDate, "yyyymm")

'set IssueDay to the relevant weekday
IssueDay = WeekDay(StockDate)

'sefine query text to select IssueDay and average issue for
selected blood group, product, and month
strSQL = "SELECT IssueDay, c" & BloodGroup & " FROM
stbl_NominalLSC " _
& "WHERE Month = " & IssueMonth & " AND
ProductGroupID=" & ProductGroupID

'set the database reference and open a recordset based on teh
above query. This recordset will be stepped through sequentially
'to deplete the Stock and eventually calculate the days worth of
stock (LSC)
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot, dbDenyWrite,
dbOptimistic)

'set the flg to zero
flgJumpOut = 0

'Set the running total to the Selected Days Total Stock
RunningTotal = TotalStock

'Set the DayCount to the current day of the week
DayCount = IssueDay

'Loop through until the flag is set to 1
Do Until flgJumpOut = 1

'find the average issue for the selected day
rst.FindFirst "IssueDay = " & DayCount

'If nothing is found, i.e. an error, set the function value to
something silly
If rst.NoMatch = True Then
LiteralStockCover = 9999
GoTo Err_Cleanup
End If

'Ammend the runningtotal to be the previous value - the selected
days issues
RunningTotal = RunningTotal - rst(1).Value

'if the running total is still greater than zero then increase the
LSC count by one and the Day count by one
If RunningTotal >= 0 Then
LSC = LSC + 1
DayCount = DayCount + 1

'if the day count is greater than 7 (i.e. Saturday), reset it
to 1 (Sunday)
If DayCount > 7 Then: DayCount = 1
Else
'if the value is less than zero, calculate the remaining
fraction and add to the LSC count.
'set the flag to jump out of the loop
LSC = LSC + ((RunningTotal / rst(1).Value) + 1)
flgJumpOut = 1
End If

Loop
'set the final function value to the variable which has stored the
count through the function
LiteralStockCover = LSC

'if something goes wrong, set the variables to nowt and end the
function.
Err_Cleanup:
If Err Then: MsgBox Err.Description
rst.Close
Set rst = Nothing
Set db = Nothing

End Function

 

[Tim Ferguson]

(e-mail address removed) (Rob Hick) wrote in

"Major design issue" - I'm not sure what you mean by normalise

To be honest, there really is little point in getting the Access disks out
of the box if you are not going to bother to take any interest in how to do
database design. This is not like Word: you can't just pick up the keyboard
and start typing.

"Issue Month as string" - I've declared this as type variant purely
out of habit.

Getting data types right is not so much about speeding up performance as
making sure that the function goes right, predictably, and that you can
understand the thing later.

"using Mod function" - not familiar with this

So look it up in help: brute force is no substitute for a proper algorithm.

"DLookup" - I am indeed only looking up one value to minus from the
RunningTotal (see below). I thought it would be quickest to open one
recordset and then step through the values

But I did not see any values being stepped through: unless I missed it,
there is not a single rs.MoveNext line anywhere?

"Exponential decay" - i think it's just linear decay

You referred to "inventory depletes by an average amount each
successive day" which is subject to different interpretations: as I said
earlier, from this code it's not possible to tell what you are trying to
acheive.


The bottom line is that this is poorly conceived, poorly executed and
dreadfully presented code, somewhat reminiscent of the dark days of the
1970s, but utterly out of place in this century. If you do want to get
serious about programming, may I introduce you to a coule of books:

The Mythical Man-Month by Frederick P. Brooks

Code Complete by Steve McConnell

If you read these and still think that this is the correct way to do
programming, feel free to come back and say why!

All the best


Tim F

 

[Rob Hick]

Hi Tim,

Thanks for your message - sorry if i've caused offence, it was not my
intention. I'm aware i know very little about coding which was why i
thought i'd post a message to see if i was using a hugely circuitous
route to do something that isn't that difficult. I'll leave my code
out of it and attempt to explain better what i'm lloking to do.

I have 2 tables - one containing daily stock counts:

StockDate ProductGroupID OPos ONeg etc......
01/04/2002 1 11961 4149
02/04/2002 1 11874 4083
03/04/2002 1 11074 3897
etc.....

and another containing average issue (i.e. what we'd expect to use in
a day) by month and weekday:

Month IssueDay ProductGroupID cOPos cONeg etc...
200204 1 1 437.5 139.6
200204 1 2 113.6 31.8
200204 2 1 2995.6 802.0
200204 2 2 277.2 72.8
200204 3 1 2602.6 677.6
200204 3 2 254.3 66.5
200204 4 1 3102.9 773.8
200204 4 2 277.3 68.5
200204 5 1 2888.1 739.0
200204 5 2 288.0 365.0
200204 6 1 2980.4 742.8
200204 6 2 305.9 75.5
200204 7 1 631.7 213.6
200204 7 2 147.0 39.4
200205 1 1 447.5 139.6
200205 1 2 113.5 30.6
etc.....

What i am attempting to do is calculate the number of days the stock
we have will last if no more product was produced. To do this i have
taken the daily stock value (e.g. 11961) and then minused the average
issue for that day (i.e. 1/4/02 = Monday, avg issue = 2995.6). If
there is still stock left, take the next days avg issue (Tuesday, avg
issue = 2602.6). and so on...., until there is not enough stock left
to issue a full day, then calculate the fraction of the day which
could be issued(e.g. 100 units in stock, avg issue = 400, 0.25 days
worth of stock)

My only idea for the code was to iteratively calculate the value as
described above. My query was whether there is a quicker way to do it
as the code i've written is quite slow. I've tried using DLookup to
get each avg issue value but it seemed slower (not much in it really)
than opening the table as a recordset and using the FindFirst method.
I had looked into the Mod Function in help but am not sure how you
think this would help.

once again, thanks for your comments
Rob

 

[Tim Ferguson]

(e-mail address removed) (Rob Hick) wrote in

My only idea for the code was to iteratively calculate the value as
described above. My query was whether there is a quicker way to do it
as the code i've written is quite slow. I've tried using DLookup to
get each avg issue value but it seemed slower (not much in it really)
than opening the table as a recordset and using the FindFirst method.
I had looked into the Mod Function in help but am not sure how you
think this would help.

A couple of questions:
Are the "average expected" consumption figures computed or stored -- in
other words, if there is some mathematical way of deriving them, it would
almost certainly be more accurate and quicker to do it that way than
putting them in a table. Disk fetches are _very_ slow compared to
calculations. If there is arithmetic to do, then do it that way. If it's
really random, then presumably iteration may be the only way to go. One of
your local statisticians may be able to help.

I would still seriously consider normalising the tables: for example

Month Day PG Gp Stock
200204 1 1 OPos 437.5
200204 1 1 ONeg 139.6
200204 1 2 OPos 113.6
200204 1 2 ONeg 31.8
200204 2 1 OPos 2995.6
200204 2 1 ONeg 802.0
200204 2 2 OPos 277.2
200204 2 2 ONeg 72.8


and so on. Long thin tables are much easier as well as quicker to
manipulate.

I also see, looking at your code, that there is a hidden "step-through" the
recordset: again, with a bit of planning you can put the recordset in order
with only the records you need and avoid the searching.

I would still recommend looking at the books!
All the best


Tim F

 

[Rob Hick]

Are the "average expected" consumption figures computed or stored

I'm calculating the avg consumption figures in a separate query and
storing the values in a table. The avg day value for a month is the
average consumption for that day over the previous 6 months so i think
to calculate it on the fly would be slower.

I've set the sort order of the recordset and am now stepping through
successive values as you suggested. I've also added a step to
calculate the total weekly consumption and then calculate the number
of times this will go into the total stock. This shortcuts the
calculation because it limits the number of cycles through the
recordset to 1.

I'll post the final code below. Thanks for your help and i will
definately look into normalising my tables, and maybe even get hold of
the books!!

thanks again.
Rob

code follows:
Public Function LiteralStockCover(TotalStock As Double, ByVal
BloodGroup As String, ByVal ProductGroupID As Integer, ByVal StockDate
As Date) As Single
'This function will calculate the number of days the a given stock
level will last in real-time days.
'Each day of the week has a calculated average issue and the function
will step through these values successively
'depending on the start day, until the Stock has dropped below zero.
'The final day is then calculated as a fraction to give the number of
days to the nearest 2 sig fig.

Dim db As Database 'will hold database reference
Dim rst As Recordset 'will hold record set reference
Dim strSQL As String 'will hold necessary SQL string
Dim RunningTotal As Double 'will store value of the Stock as function
steps through values and depletes the stock
Dim LSC As Single 'will hold the count of the days the
function has stepped through
Dim IssueMonth As Variant 'the month that the Stock Date concerned
is in, in yyyymm format
Dim IssueDay As Integer 'the day of the week that is the initial
stock date
Dim AvgWeekIssue As Double 'hold the sum average issues for the week

On Error GoTo Err_Cleanup
'set IssueMonth to the relevant month and format
IssueMonth = format(StockDate, "yyyymm")

'set IssueDay to the relevant weekday
IssueDay = WeekDay(StockDate)

'sefine query text to select IssueDay and average issue for
selected blood group, product, and month
strSQL = "SELECT IssueDay, c" & BloodGroup & " FROM
stbl_NominalLSC " _
& "WHERE Month = " & IssueMonth & " AND
ProductGroupID=" & ProductGroupID _
& " ORDER BY IssueDay"

'set the database reference and open a recordset based on teh
above query. This recordset will be stepped through sequentially
'to deplete the Stock and eventually calculate the days worth of
stock (LSC)
Set db = CurrentDb
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot, dbDenyWrite,
dbOptimistic)

'Set the running total to the Selected Days Total Stock
RunningTotal = TotalStock

'find the average total weekly issue
AvgWeekIssue = DSum("c" & BloodGroup, "stbl_NominalLSC", _
"Month = " & IssueMonth _
& " and ProductGroupID = " & ProductGroupID)

LSC = 7 * (RunningTotal \ AvgWeekIssue)
RunningTotal = RunningTotal - ((RunningTotal \ AvgWeekIssue) *
AvgWeekIssue)

'find the average issue for the selected day
rst.FindFirst "IssueDay = " & IssueDay

'If nothing is found, i.e. an error, set the function value to
something silly
If rst.NoMatch = True Then
LiteralStockCover = 9999
GoTo Err_Cleanup
End If

'Loop through until the flag is set to 1
Do Until RunningTotal < 0

'Ammend the runningtotal to be the previous value - the selected
days issues
RunningTotal = RunningTotal - rst(1).Value

'if the running total is still greater than zero then increase the
LSC count by one and move to the next day
If RunningTotal >= 0 Then
LSC = LSC + 1
' if at end of field, move to the first record, otherwise move
to the next
rst.MoveNext
If rst.EOF Then: rst.MoveFirst
Else
'if the value is less than zero, calculate the remaining
fraction and add to the LSC count.
LSC = LSC + ((RunningTotal / rst(1).Value) + 1)
End If

Loop
'set the final function value to the variable which has stored the
count through the function
LiteralStockCover = LSC

'if something goes wrong, set the variables to nowt and end the
function.
Err_Cleanup:
If Err Then: MsgBox Err.Description
rst.Close
Set rst = Nothing
Set db = Nothing

End Function