Solved

VBA function to loop and reduce inventory in Access

Posted on 2011-02-23
8
770 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 250 total points
Comment Utility
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
Comment Utility
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 119

Assisted Solution

by:Rey Obrero
Rey Obrero earned 250 total points
Comment Utility
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
 

Author Comment

by:Russian_Lmg
Comment Utility
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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
<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
Comment Utility
Without a sample of the data this would be hard to diagnose.
0
 
LVL 37

Expert Comment

by:Neil Russell
Comment Utility
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
Comment Utility
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Go is an acronym of golang, is a programming language developed Google in 2007. Go is a new language that is mostly in the C family, with significant input from Pascal/Modula/Oberon family. Hence Go arisen as low-level language with fast compilation…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

771 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now