VBA Module with LOOP

[arkadis]

:banghead::banghead::banghead:
Hi everyone,

This is my first post here. I am trying for 2 days now to create a module that will make FIFO calculation in my APP.
I am using 2 queries to pull the data.
1) zFifoExOst - The query that holds all my sales
2) zFifoObOst - The query that holds all my purchase

each variable starting with "e" has to do with sale
each variable starting with "o" has to do with purchase

The problem is that when my Sale Quantity is greater than my Purchase i am getting a loop over same record over and over.

I am not a profy in vba programming so it can be something stupid.

Anyway thanks in advance.

The code:

Option Compare Database
Option Explicit

Public eProductID As Long
Public eRecID As Long
Public eQty As Double
Public eParty As Long
Public eDate As Date

Public oRecId As Long
Public oQty As Double
Public oParty As Long
Public oDate As Long

Public eQtyLeft As Double
Public eQtyCounted As Double
Public oQtyLeft As Double
Public Row As Long

Public Function GetIDFIFO()
GetIDFIFO = eProductID
End Function

Public Sub FIFOloop()
Row = 0
eQtyLeft = 0
eQtyCounted = 0
oQtyLeft = 0

Dim FIFOexpend As Recordset
Set FIFOexpend = CurrentDb.OpenRecordset("zFifoExOst ")
    If FIFOexpend.RecordCount <> 0 Then
        FIFOexpend.MoveLast
        FIFOexpend.MoveFirst
        Do While Not FIFOexpend.EOF
            eProductID = FIFOexpend.Fields("GoodsID")
            eRecID = FIFOexpend.Fields("ExpendGoodsID")
            eQty = FIFOexpend.Fields("CountUnits") - eQtyCounted
            eParty = FIFOexpend.Fields("KodParty")
            eDate = FIFOexpend.Fields("DateExpend")
            
            Dim FIFOobtain As Recordset
            Set FIFOobtain = CurrentDb.OpenRecordset("zFifoObOst ")
                If FIFOobtain.RecordCount <> 0 Then
                    FIFOobtain.MoveLast
                    FIFOobtain.MoveFirst
                    oRecId = FIFOobtain.Fields("GoodsID")
                    oQty = FIFOobtain.Fields("CountUnits")
                    oParty = FIFOobtain.Fields("KodParty")
                    oDate = FIFOobtain.Fields("DateExpend")
                
                        If oQty >= eQty Then
                            'Add to rst
                            oQtyLeft = oQty - eQty
                            eQtyLeft = 0
                            eQtyCounted = 0
                            Row = Row + 1
                            'Update the obtain
                            
                            'Debug.Print "OstOb: " & oQtyLeft & "Row: " & Row
                        ElseIf oQty < eQty Then
                            'Debug.Print "Expend Greater" & "Row: " & Row
                            oQtyLeft = 0
                            eQtyLeft = eQty - oQty
                            eQtyCounted = eQty - eQtyLeft
                            Row = Row + 1
                        End If
                
                Else
                    MsgBox ("Obtain Missing for the Expend Record " & eRecID)
                    GoTo LastLine
                End If
            FIFOobtain.Close
        If eQtyLeft = 0 Then
            FIFOexpend.MoveNext
       [B][COLOR="Red"] ElseIf eQtyLeft > 0 Then[/COLOR][/B]
            FIFOexpend.MoveNext
            FIFOexpend.MovePrevious
        End If
        Debug.Print "Row: " & Row; " Good : " & eProductID; " Expend ID: " & eRecID & " Obtain ID: " & oRecId
        Loop
    End If
LastLine:
FIFOexpend.Close
Set FIFOexpend = Nothing
Set FIFOobtain = Nothing

eProductID = 0
eRecID = 0
eQty = 0
eParty = 0
eDate = 0
oRecId = 0
oQty = 0
oParty = 0
oDate = 0
End Sub

 

[sneuberg]

If you would document you code with what you are trying to do you might:

a. Find the problem yourself
b. Find more forum members that would be willing to read it

The code segment

FIFOexpend.MoveNext
FIFOexpend.MovePrevious

looks strange. Why are you doing that?

 

[arkadis]

If you would document you code with what you are trying to do you might:

a. Find the problem yourself
b. Find more forum members that would be willing to read it

The code segment

FIFOexpend.MoveNext
FIFOexpend.MovePrevious

looks strange. Why are you doing that?

This is a function to distribute all sales and purchase using FIFO "Accounting" method "First In - First Out

If eQtyLeft = 0 Then 'Here i am cheking if the purchase covered all the expend
            FIFOexpend.MoveNext
        ElseIf eQtyLeft > 0 Then
            FIFOexpend.MoveNext
            FIFOexpend.MovePrevious
        End If

eQty is the quantity of the products sold in a single invoice
oQty is the quantity of the products purchased in a single invoice
if the quantity sold is greater than the quantity of the first purchase i have a value named "eQtyLeft"
So if I have a "eQtyLeft" greater than 0 then i want to stay on the record and go through the function again until i cover the quantity.
Also i am calculating the counted sold products as eQtyCounted.
Code works fine and breaks only when i have Sales greater than Purchases.


Thanks!

 

[arkadis]

Finally Works!
This module is to distribute costs based on FIFO method.
If someone needs detailed information fill free to ask.!!!!

Option Compare Database
Option Explicit

Public eParty As Long
Public eDate As Date
Public eProductID As Long
Public eRecID As Long
Public eQty As Double
Public ePrice As Double

Public oParty As Long
Public oDate As Long
Public oRecId As Long
Public oQty As Double
Public oPrice As Double

Public eQtyLeft As Double
Public eQtyCounted As Double
Public oQtyLeft As Double
Public Row As Long

Public Function GetIDFIFO()
GetIDFIFO = eProductID
End Function

Public Sub FIFOloop()
Row = 0
eQtyLeft = 0
eQtyCounted = 0
oQtyLeft = 0

Dim FIFOexpend As Recordset
Set FIFOexpend = CurrentDb.OpenRecordset("zFifoExOst ")
    FIFOexpend.MoveLast
    FIFOexpend.MoveFirst
If FIFOexpend.RecordCount <> 0 Then
        Do While Not FIFOexpend.EOF
            eProductID = FIFOexpend.Fields("GoodsID")
            eRecID = FIFOexpend.Fields("ExpendGoodsID")
            eQty = FIFOexpend.Fields("CountUnits") - eQtyCounted
            eParty = FIFOexpend.Fields("KodParty")
            eDate = FIFOexpend.Fields("DateExpend")
            ePrice = FIFOexpend.Fields("Psaleprice")
Dim FIFOobtain As Recordset
Set FIFOobtain = CurrentDb.OpenRecordset("zFifoObOst ")
    FIFOobtain.MoveLast
    FIFOobtain.MoveFirst
If FIFOobtain.RecordCount <> 0 Then

            oRecId = FIFOobtain.Fields("ObtainsID")
            oQty = FIFOobtain.Fields("CountUnits")
            oParty = FIFOobtain.Fields("KodParty")
            oDate = FIFOobtain.Fields("DateExpend")
            oPrice = Round(FIFOobtain.Fields("rsCOst"), 2)
                        
                If oQty >= eQty Then
                    'Add to rst
                    oQtyLeft = oQty - eQty
                    eQtyLeft = 0
                    eQtyCounted = 0
                    Row = Row + 1
                ElseIf oQty < eQty Then
                    'Debug.Print "Expend Greater" & "Row: " & Row
                    oQtyLeft = 0
                    eQtyLeft = eQty - oQty
                    eQtyCounted = eQty - eQtyLeft
                    Row = Row + 1
                End If
                            
Dim rstFIFO As Recordset
Set rstFIFO = CurrentDb.OpenRecordset("zAccFIFO ")
                With rstFIFO
                    .AddNew
                    .Fields("GoodsID") = eProductID
                    .Fields("ob_record_id") = oRecId
                    .Fields("ob_party") = oParty
                    .Fields("ob_date") = oDate
                    .Fields("ob_cost") = oPrice
                    .Fields("ex_record_id") = eRecID
                    .Fields("ex_party") = eParty
                    .Fields("ex_date") = eDate
                        If eQtyCounted > 0 Then
                            .Fields("ex_units") = eQtyCounted
                        Else
                            .Fields("ex_units") = eQty
                        End If
                    .Fields("ex_price") = ePrice
                    .update
                End With
rstFIFO.Close
FIFOobtain.Close
Else
    MsgBox ("Obtain Missing for the Expend Record " & eRecID)
    GoTo LastLine
End If

NextLine:
        If eQtyLeft = 0 Then
            FIFOexpend.MoveNext
        End If
        Debug.Print "Row: " & Row; " Good : " & eProductID; " Expend ID: " & eRecID & " Obtain ID: " & oRecId & " oQty: " & oQty & " eQty: " & eQty & " eQtyLeft: " & eQtyLeft & " oQtyLeft: " & oQtyLeft & " eQtyCounted: " & eQtyCounted
        Loop
    End If

LastLine:
FIFOexpend.Close
Set FIFOexpend = Nothing
Set FIFOobtain = Nothing

eProductID = 0
eRecID = 0
eQty = 0
eParty = 0
eDate = 0
oRecId = 0
oQty = 0
oParty = 0
oDate = 0
End Sub