Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

VBA function to loop and reduce inventory in Access

Posted on 2011-02-23
8
Medium Priority
?
794 Views
Last Modified: 2012-05-11
The purpose of this function is to look at requirements for a particular item by job in a date descending order, look at the available inventory on hand, and reduce that by the requirements for a job.  When the on hand inventory is exhausted, then it needs to check what is sitting in an inspection location, and move the consumption from good to the inspection quantity.

In the event that it runs negative, that is fine at the end, but it can only do that after it has reduced all good, then all inspection.

I have been trying to get some existing code that was in use here to perform this function, but I think I am stuck at this point.  I keep getting a Loop without Do message and try as I might, I cannot figure out which of my changes is causing it.

Prior to the Loop without Do error, I was getting the inventory levels to reduce, but only on the Good Inventory portion, the QC/Inspection portion was remaining the same (though I think I was close to fixing that).  Any help would be great, because I do not think that I am far off.

Here is the code below.  I also attached an Excel file which is the basic idea of what the result would be.  Green is the start of normal deductions, Yellow is out of QC, Red is the end of the line.  Hopefully this is all clear enough.   I will be back online around 9 am (need to finally go to sleep for a few hours).


Open in new window

Public Function CalcAGE1()

    Dim rst As DAO.Recordset
    Dim SQLQuery As String
    Dim qty_oh As Double  'asoh
    Dim qty_r As Double 'total_qty
    Dim new_qoh As Double 'new_usoh
    Dim new_qoh_prev As Double 'new_usoh_prev
    Dim item_prev As String 'Item_No_Prev
    Dim item As String 'Item_No
    Dim ord_no As String 'Ord_No
   ' Dim Ord_Type As String
   Dim status As String
   Dim start_date As Date
   Dim qcqty_oh As Double
   Dim qcnew_qoh As Double
   Dim qcnew_qoh_prev As Double
   Dim new_qtyr As Double
   
   
   
       
    ' OpenQuery (2)
   
    Set db = CurrentDb
DBEngine.SetOption dbMaxLocksPerFile, 200000
    SQLQuery = "SELECT tbl_order_age.ord_no, tbl_order_age.item, tbl_order_age.qty_oh, tbl_order_age.qty_r, tbl_order_age.new_qoh, tbl_order_age.status, tbl_order_age.ord_no, tbl_order_age.start_date, tbl_order_age.qcqty_oh, tbl_order_age.newqty_r, tbl_order_age.qcnew_qoh FROM tbl_order_age order by tbl_order_age.item, tbl_order_age.status, tbl_order_age.start_date,tbl_order_age.ord_no;"
    'MsgBox SQLQuery
   
    Set rst = db.OpenRecordset(SQLQuery)
        rst.MoveFirst
   
    item_prev = ""
    new_qoh_prev = 0
    qcnew_qoh_prev = 0  '
   
    Do Until rst.EOF
        qty_oh = rst!qty_oh
        qty_r = rst!qty_r
        qcqty_oh = rst!qcqty_oh
        item = rst!item
        If item_prev = item Then
         If new_qoh > qty_r Then
            new_qoh = new_qoh_prev - qty_r
            End If
        ElseIf item_prev = item Then
        If new_qoh < qty_r Then
        If qcqty_oh > qty_r Then
        qcnew_qoh = (new_qoh_prev + qcqty_oh) - newqty_r
        End If
        Else: new_qoh = qty_oh - qty_r
        End If
               
        'MsgBox New_USOH
       
        rst.Edit
        rst!new_qoh = new_qoh
        rst!qcnew_qoh = qcnew_qoh
       
        rst.Update
        item_prev = rst!item
        new_qoh_prev = rst!new_qoh
        qcnew_qoh_prev = rst!qcnew_qoh
        rst.MoveNext
    Loop
   
    ' OpenQuery (3)
   
    End Function
tbl-order-age.xls
0
Comment
Question by:Russian_Lmg
  • 3
  • 3
  • 2
8 Comments
 
LVL 37

Accepted Solution

by:
Neil Russell earned 1000 total points
ID: 34959358
You are missing an END IF statement i think.

Dont use
Else: new_qoh = qty_oh - qty_r

Use

Else
   new_qoh = qty_oh - qty_r
Endif
0
 

Author Comment

by:Russian_Lmg
ID: 34960558
Ok, sleep is good.  I tried the new statement you provided Neilsr but the result is the same, Loop without Do.

I noticed I was missing some undefined items, so I fixed that, and I was wondering if my IF statements were missing something, so I added another one to see if that worked, since there was possible results that were not setup in the IF statements as of last night.

The new updated code is below.  

Open in new window


Public Function CalcAGE1()

    Dim rst As DAO.Recordset
    Dim SQLQuery As String
    Dim qty_oh As Double  'asoh
    Dim qty_r As Double 'total_qty
    Dim new_qoh As Double 'new_usoh
    Dim new_qoh_prev As Double 'new_usoh_prev
    Dim item_prev As String 'Item_No_Prev
    Dim item As String 'Item_No
    Dim ord_no As String 'Ord_No
   Dim status As String
   Dim start_date As Date
   Dim qcqty_oh As Double
   Dim qcnew_qoh As Double
   Dim qcnew_qoh_prev As Double
   Dim newqty_r As Double
   
   
       
    ' OpenQuery (2)
   
    Set db = CurrentDb
DBEngine.SetOption dbMaxLocksPerFile, 200000
    SQLQuery = "SELECT tbl_order_age.ord_no, tbl_order_age.item, tbl_order_age.qty_oh, tbl_order_age.qty_r, tbl_order_age.new_qoh, tbl_order_age.status, tbl_order_age.ord_no, tbl_order_age.start_date, tbl_order_age.qcqty_oh, tbl_order_age.qcnew_qoh tbl_order_age.newqty_r FROM tbl_order_age order by tbl_order_age.item, tbl_order_age.status, tbl_order_age.start_date,tbl_order_age.ord_no;"
    'MsgBox SQLQuery
   
    Set rst = db.OpenRecordset(SQLQuery)
        rst.MoveFirst
   
    item_prev = ""
    new_qoh_prev = 0
    qcnew_qoh_prev = 0
   
    Do Until rst.EOF
        qty_oh = rst!qty_oh
        qty_r = rst!qty_r
        qcqty_oh = rst!qcqty_oh
        newqty_r = rst!newqty_r
      item = rst!item
        If item_prev = item Then
         If new_qoh > qty_r Then
            new_qoh = new_qoh_prev - qty_r
            End If
        ElseIf item_prev = item Then
        If new_qoh < qty_r Then
        If qcqty_oh > qty_r Then
        qcnew_qoh = (new_qoh_prev + qcqty_oh) - newqty_r
        End If
        ElseIf item_prev = item Then
        If new_qoh < qty_r Then
        If qcqty_oh < qty_r Then
        qcnew_qoh = qcnew_qoh_prev - newqty_r
        End If
        Else
        new_qoh = qty_oh - qty_r
        End If
               
        'MsgBox New_USOH
       
        rst.Edit
        rst!new_qoh = new_qoh
        rst!qcnew_qoh = qcnew_qoh
       
        rst.Update
        item_prev = rst!item
        new_qoh_prev = rst!new_qoh
        qcnew_qoh_prev = rst!qcnew_qoh
        rst.MoveNext
    Loop
   
    ' OpenQuery (3)
   
    End Function

0
 
LVL 120

Assisted Solution

by:Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1) earned 1000 total points
ID: 34960586
try this revised code
Option Compare Database
Option Explicit

Public Function CalcAGE1()

Dim rst As DAO.Recordset, db As DAO.Database
Dim SQLQuery As String
Dim qty_oh As Double  'asoh
Dim qty_r As Double 'total_qty
Dim new_qoh As Double 'new_usoh
Dim new_qoh_prev As Double 'new_usoh_prev
Dim item_prev As String 'Item_No_Prev
Dim item As String 'Item_No
Dim ord_no As String 'Ord_No
' Dim Ord_Type As String
Dim status As String
Dim start_date As Date
Dim qcqty_oh As Double
Dim qcnew_qoh As Double
Dim qcnew_qoh_prev As Double
Dim new_qtyr As Double

   
   
       
    ' OpenQuery (2)
   
    Set db = CurrentDb
DBEngine.SetOption dbMaxLocksPerFile, 200000
    SQLQuery = "SELECT tbl_order_age.ord_no, tbl_order_age.item, tbl_order_age.qty_oh, tbl_order_age.qty_r, tbl_order_age.new_qoh, tbl_order_age.status, tbl_order_age.ord_no, tbl_order_age.start_date, tbl_order_age.qcqty_oh, tbl_order_age.newqty_r, tbl_order_age.qcnew_qoh FROM tbl_order_age order by tbl_order_age.item, tbl_order_age.status, tbl_order_age.start_date,tbl_order_age.ord_no;"
    'MsgBox SQLQuery
   
    Set rst = db.OpenRecordset(SQLQuery)
        rst.MoveFirst
   
    item_prev = ""
    new_qoh_prev = 0
    qcnew_qoh_prev = 0  '
   
Do Until rst.EOF
qty_oh = rst!qty_oh
qty_r = rst!qty_r
qcqty_oh = rst!qcqty_oh
item = rst!item
    If item_prev = item Then
        If new_qoh > qty_r Then
            new_qoh = new_qoh_prev - qty_r
        End If
'    ElseIf item_prev = item Then
    ElseIf item_prev <> item Then
        If new_qoh < qty_r Then
            If qcqty_oh > qty_r Then
'                qcnew_qoh = (new_qoh_prev + qcqty_oh) - newqty_r
                qcnew_qoh = (new_qoh_prev + qcqty_oh) - qty_r
            End If
        Else
            new_qoh = qty_oh - qty_r
        End If
    End If
    'MsgBox New_USOH
    
    rst.Edit
    rst!new_qoh = new_qoh
    rst!qcnew_qoh = qcnew_qoh
    
    rst.Update
    item_prev = rst!item
    new_qoh_prev = rst!new_qoh
    qcnew_qoh_prev = rst!qcnew_qoh
    rst.MoveNext
Loop
   
    ' OpenQuery (3)
   
End Function

Open in new window

0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:Russian_Lmg
ID: 34960792
Capricorn1, that worked and got me past the Loop without Do.

However, the QC part is getting set to 0 instantly, long before it should.  Does the update portion at the end require some criteria to make it fire only when the criteria are met in the IF portion?

0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 34960825
<the QC part is getting set to 0 instantly, long before it should.>
well, you have to rethink the process and logic you are executing using your codes
0
 
LVL 37

Expert Comment

by:Neil Russell
ID: 34962131
Without a sample of the data this would be hard to diagnose.
0
 
LVL 37

Expert Comment

by:Neil Russell
ID: 34962150
And WHAT exactly is getting set to 0? You say "the QC part", there are lots of variables and fields called qcSOMETHING
0
 

Author Comment

by:Russian_Lmg
ID: 34962244
The data was in the attached excel file.  In any event, what I did was split the function into two, the first part to reduce the Good Inventory.  Then once that was reduced, a second with some criteria to limit the results which accomplished what I wanted in the Inspection/QC qty.

Thank you for the advice and help.  Getting the logic (Back to the drawing board) comment was a good idea.

Final code, in the event someone could use it.  Runs about 10 seconds against 9000 records.


Open in new window

Option Compare Database
Option Explicit

Public Function CalcAGE1()

Dim rst As DAO.Recordset, db As DAO.Database
Dim SQLQuery As String
Dim qty_oh As Double  'asoh
Dim qty_r As Double 'total_qty
Dim new_qoh As Double 'new_usoh
Dim new_qoh_prev As Double 'new_usoh_prev
Dim item_prev As String 'Item_No_Prev
Dim item As String 'Item_No
Dim ord_no As String 'Ord_No
' Dim Ord_Type As String
Dim status As String
Dim start_date As Date
Dim qcqty_oh As Double
Dim qcnew_qoh As Double
Dim qcnew_qoh_prev As Double
Dim new_qtyr As Double

   
   
       
    ' OpenQuery (2)
   
    Set db = CurrentDb
DBEngine.SetOption dbMaxLocksPerFile, 200000
    SQLQuery = "SELECT tbl_order_age.ord_no, tbl_order_age.item, tbl_order_age.qty_oh, tbl_order_age.qty_r, tbl_order_age.new_qoh, tbl_order_age.status, tbl_order_age.ord_no, tbl_order_age.start_date FROM tbl_order_age order by tbl_order_age.item, tbl_order_age.status, tbl_order_age.start_date,tbl_order_age.ord_no;"
    'MsgBox SQLQuery
   
    Set rst = db.OpenRecordset(SQLQuery)
        rst.MoveFirst
   
    item_prev = ""
    new_qoh_prev = 0
   
    Do Until rst.EOF
        qty_oh = rst!qty_oh
        qty_r = rst!qty_r
        item = rst!item
        If item_prev = item Then
            new_qoh = new_qoh_prev - qty_r
        Else
            new_qoh = qty_oh - qty_r
        End If
               
        'MsgBox New_USOH
       
        rst.Edit
        rst!new_qoh = new_qoh
       
        rst.Update
        item_prev = rst!item
        new_qoh_prev = rst!new_qoh
        rst.MoveNext
    Loop
   
    ' OpenQuery (3)
   
    End Function
   
    Public Function CalcAGE2()

Dim rst As DAO.Recordset, db As DAO.Database
Dim SQLQuery As String
Dim qty_oh As Double  'asoh
Dim qty_r As Double 'total_qty
Dim new_qoh As Double 'new_usoh
Dim new_qoh_prev As Double 'new_usoh_prev
Dim item_prev As String 'Item_No_Prev
Dim item As String 'Item_No
Dim ord_no As String 'Ord_No
' Dim Ord_Type As String
Dim status As String
Dim start_date As Date
Dim qcqty_oh As Double
Dim qcnew_qoh As Double
Dim qcnew_qoh_prev As Double
Dim newqty_r As Double

   
   
       
    ' OpenQuery (2)
   
    Set db = CurrentDb
DBEngine.SetOption dbMaxLocksPerFile, 200000
    SQLQuery = "SELECT tbl_order_age.ord_no, tbl_order_age.item, tbl_order_age.qty_oh, tbl_order_age.qty_r, tbl_order_age.new_qoh, tbl_order_age.status, tbl_order_age.ord_no, tbl_order_age.start_date, tbl_order_age.qcqty_oh, tbl_order_age.newqty_r, tbl_order_age.qcnew_qoh FROM tbl_order_age where tbl_order_age.new_qoh < tbl_order_age.qty_R and qcqty_oh > 0 order by tbl_order_age.item, tbl_order_age.status, tbl_order_age.start_date,tbl_order_age.ord_no;"
    'MsgBox SQLQuery
   
    Set rst = db.OpenRecordset(SQLQuery)
        rst.MoveFirst
   
    item_prev = ""
    qcnew_qoh_prev = 0
   
    Do Until rst.EOF
        qcqty_oh = rst!qcqty_oh
        newqty_r = rst!newqty_r
        item = rst!item
        new_qoh = rst!new_qoh
        If item_prev = item Then
            qcnew_qoh = qcnew_qoh_prev - newqty_r
        Else
            qcnew_qoh = qcqty_oh + new_qoh - qty_r
        End If
               
        'MsgBox New_USOH
       
        rst.Edit
        rst!qcnew_qoh = qcnew_qoh
       
        rst.Update
        item_prev = rst!item
        qcnew_qoh_prev = rst!qcnew_qoh
        rst.MoveNext
    Loop
   
    ' OpenQuery (3)
   
    End Function
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In real business world data are crucial and sometimes data are shared among different information systems. Hence, an agreeable file transfer protocol need to be established.
If you are a mobile app developer and especially develop hybrid mobile apps then these 4 mistakes you must avoid for hybrid app development to be the more genuine app developer.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Introduction to Processes

824 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question