FIFO Method Inventory Calculation

I think this more like an accounting question.

Yes Bro,

FIFO Method means First in First Out Based on Date

I have to take rate whichever i Have purchased First(Date)

Rows 4 & 5 in Sheet2 are confusing.

It should be sorted by the date.

Let me explain you all

say i have 10Nos of X Inventory
Purchased
Date Nos Rate of Purchase
1st April 2 100
2nd April 5 120
3rd April 5 150

Say I have sold 5 Nos of 2nd April
then Cost of 5 Nos will be (2*100)+(3*120) = 560

now my new inventory will be like this

Date Nos Rate Sales Closing
1st April 2 100 2 0
2nd April 5 120 3 2
3rd April 5 150 0 5


now again if I sold 3 Nos then cost will be (3*150)=450

my next inventory will be
Date Nos Rate Sales Closing
1st April 2 100 2 0
2nd April 5 120 5 0
3rd April 5 150 3 2



friends plz help

You are missing what I mean.

Invoice 3 and 4 are dated 2012/4/7 and 2012/4/6 respectively.

I know FIFO.
The stock should be consumed in date order, but yours does not....

See your file carefully and if it is still correct, maybe I don't understand FIFO at all.

ahaa sorry my mistake,

yeah must be in date order,

was Sleepy while creating the sheet


yeah you are right based on date


can you help me

Test the attached hard.

bro Thanx for reply
its really working fine awesome
but only one condition is missing in this
if my Sales qty is going Greater than my available inventory then it should not proceed

Replace "FIFO" with the following

Sub FIFO()
    Dim a, i As Long, n As Long, txt As String, e, w
    Dim CD As Double, QTY As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    a = Sheets("inward").Range("a1").CurrentRegion.Value
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    For i = 2 To UBound(a, 1)
        txt = Join$(Array(a(i, 3), a(i, 4)), Chr(2))
        If Not dic.exists(txt) Then
            Set dic(txt) = CreateObject("Scripting.Dictionary")
        End If
        dic(txt)(a(i, 1)) = VBA.Array(a(i, 5), a(i, 6))
    Next
    With Sheets("outward").Cells(1).CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, Header:=xlYes
        .Offset(1, 5).ClearContents
        For i = 2 To .Rows.Count
            txt = Join$(Array(.Cells(i, 3).Value, .Cells(i, 4).Value), Chr(2))
            If dic.exists(txt) Then
                CD = .Cells(i, 5).Value
                n = 0
                For Each e In dic(txt)
                    w = dic(txt)(e)
                    If CD > 0 Then
                        If CD <= w(0) Then
                            w(0) = w(0) - CD
                            QTY = CD
                            CD = 0
                        Else
                            QTY = w(0)
                            CD = CD - w(0)
                            w(0) = 0
                        End If
                        .Cells(i, 6 + n).Resize(, 3).Value = _
                        Array(QTY, e, QTY * w(1))
                        n = n + 3
                        dic(txt)(e) = w
                        If w(0) = 0 Then dic(txt).Remove e
                    End If
                Next
                If CD > 0 Then
                    MsgBox .Cells(i, 3) & " " & .Cells(i, 4) & vbLf & CD & " short", vbCritical, "Short of stock"
                    GoTo Exit_Sub
                End If
            End If
        Next
    End With
Exit_Sub:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Thanx bro
10.jpg

Sorry to Disturb you again.....

Even base on Date

if My Purchase is on 15th April and if I'm Giving sales on 14th April then should no accept again have error

and error box must have have shown the date from which the stock is going negative

Change to

Sub FIFO()
    Dim a, i As Long, n As Long, txt As String, e, w
    Dim CD As Double, QTY As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    a = Sheets("inward").Range("a1").CurrentRegion.Value
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    For i = 2 To UBound(a, 1)
        txt = Join$(Array(a(i, 3), a(i, 4)), Chr(2))
        If Not dic.exists(txt) Then
            Set dic(txt) = CreateObject("Scripting.Dictionary")
        End If
        dic(txt)(a(i, 1)) = VBA.Array(a(i, 5), a(i, 6), a(i, 2))
    Next
    With Sheets("outward").Cells(1).CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, Header:=xlYes
        .Offset(1, 5).ClearContents
        For i = 2 To .Rows.Count
            txt = Join$(Array(.Cells(i, 3).Value, .Cells(i, 4).Value), Chr(2))
            CD = .Cells(i, 5).Value
            If dic.exists(txt) Then
                n = 0
                For Each e In dic(txt)
                    w = dic(txt)(e)
                    If w(2) <= .Cells(i, 2).Value Then
                        If CD > 0 Then
                            If CD <= w(0) Then
                                w(0) = w(0) - CD
                                QTY = CD
                                CD = 0
                            Else
                                QTY = w(0)
                                CD = CD - w(0)
                                w(0) = 0
                            End If
                            .Cells(i, 6 + n).Resize(, 3).Value = _
                            Array(QTY, e, QTY * w(1))
                            n = n + 3
                            dic(txt)(e) = w
                            If w(0) = 0 Then dic(txt).Remove e
                        End If
                    End If
                Next
            End If
            If CD > 0 Then
                MsgBox .Cells(i, 3) & " " & .Cells(i, 4) & vbLf & CD & " short", _
                vbCritical, Format$(.Cells(i, 2), "mmm dd yyyy")
                GoTo Exit_Sub
            End If
        Next
    End With
Exit_Sub:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

I will enter Location on Both Sheet
Inward & Outward,

Means I have purchased Goods in XYZ & PQR Location
& M selling form XYZ then Only XYZ value should come
if I Change that XYZ into PQR then value will turn to PQR Purchase

Bro suppose if I have location criteria then
say my Location are XYZ & PQR
then i need value based on Location

Again to Get Correct Answer I have to sort purchase Data too
say If I enter 2nd April First in Purchase and 1st April Second then it is taking value of 1st stock first
or make Purchase data sort

FIFO Inventory (2).xlsx

c Attached file

I don't understand what you are saying.

c Attached file

1) I don't need to sort "Onward" as far as the caliculation is concerned.

2) Location.

Is this the last change in the format?
What if there are more than 2 locations for same items?
How do you know it always in col.O?
If the items to be listed in the same row has more than 3,
it will delete that location.

Your sheet layouts are not pretty.

I know m disturbing you alot
sorry for that

and thanx from bottom of my heart

Originally Posted by jindon

2) Location.

Is this the last change in the format?
What if there are more than 2 locations for same items?
How do you know it always in col.O?
If the items to be listed in the same row has more than 3,
it will delete that location.

You are not answering to my question.

Han the same thing is going to Happen
I will have 4 Locations & same stock will be in 4 location
then first I will select the location from where i want to out it
then the stock will out from the same location only

I m making a Group Inventory
I will i have 4 Location
n sales will be done from diff 4 locations

and Yeah this is last change

What if there are more than 2 locations for same items?
For one Outward there will not two locations
It will be in another Line item

How do you know it always in col.O?
I will Maintain Location in same col

change to

Sub FIFO()
    Dim a, i As Long, n As Long, txt As String, e, w
    Dim CD As Double, QTY As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    a = Sheets("inward").Range("a1").CurrentRegion.Value
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    For i = 2 To UBound(a, 1)
        txt = Join$(Array(a(i, 3), a(i, 4)), Chr(2))
        If Not dic.exists(txt) Then
            Set dic(txt) = CreateObject("Scripting.Dictionary")
        End If
        dic(txt)(a(i, 1)) = VBA.Array(a(i, 5), a(i, 6), a(i, 2), a(i, 8))
    Next
    With Sheets("outward").Cells(1).CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, Header:=xlYes
        .Offset(1, 5).ClearContents
        For i = 2 To .Rows.Count
            txt = Join$(Array(.Cells(i, 3).Value, .Cells(i, 4).Value), Chr(2))
            CD = .Cells(i, 5).Value
            If dic.exists(txt) Then
                n = 0
                For Each e In dic(txt)
                    w = dic(txt)(e)
                    If w(2) <= .Cells(i, 2).Value Then
                        If CD > 0 Then
                            If CD <= w(0) Then
                                w(0) = w(0) - CD
                                QTY = CD
                                CD = 0
                            Else
                                QTY = w(0)
                                CD = CD - w(0)
                                w(0) = 0
                            End If
                            .Cells(i, 6 + n).Resize(, 3).Value = _
                            Array(QTY, e, QTY * w(1))
                            .Cells(i, "o").Value = w(3)
                            n = n + 3
                            dic(txt)(e) = w
                            If w(0) = 0 Then dic(txt).Remove e
                        End If
                    End If
                Next
            End If
            If CD > 0 Then
                MsgBox .Cells(i, 3) & " " & .Cells(i, 4) & vbLf & CD & " short", _
                vbCritical, Format$(.Cells(i, 2), "mmm dd yyyy")
                GoTo Exit_Sub
            End If
        Next
    End With
Exit_Sub:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Nah Bro not like this

As you have given criteria saying
at the time of sales choose the first stock from inventory type i have given

Eg.

I sold Lamp - 30SD then
result will select first Lamp Purchased of Type 30Sd

I want Salme Result
If I have sold Lamp - 30SD from XYZ Location then
Then my Result will be
First in Lamp Purchased of Type 30SD of Location XYZ

Say
if I have given Output
Date stock Type Location Qty
1st April Lamp 30 SD XYZ 20

then it Will Search stock form Location XYZ of Inward Register

Inward

Date stock Type Location Qty
1st April Lamp 30 SD XYZ 20
2nd April Lamp 30 SD PQR 20


Now it I put in Outward

3rd April Lamp 30SD PQR 10 Then my result must come from 2nd April, not from 1st April,
As I have to out it from PQR

If I chane PQR into XYZ then my outward will come from 1st April

I don't think I'm following you.

How are you exactly entering the data in 2nd sheet? which columns?

I have got an error on this line. Initially, I thought it may be may my excel, but now I have tried it for third time and still getting the same error.

CD = .Cells(i, 5).Value

I have got answer, didn't get any error

Only thing i have to add in this is Location as i have attached latest file

When we are talking about the solution based on different format, it will never come to the end.

Sub FIFO()
    Dim a, i As Long, n As Long, txt As String, e, w
    Dim CD As Double, QTY As Long, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("inward").Range("a1").CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, Header:=xlYes
        a = .Value
    End With
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    For i = 2 To UBound(a, 1)
        txt = Join$(Array(a(i, 3), a(i, 4), a(i, 8)), Chr(2))
        If Not dic.exists(txt) Then
            Set dic(txt) = CreateObject("Scripting.Dictionary")
        End If
        dic(txt)(a(i, 1)) = VBA.Array(a(i, 5), a(i, 6), a(i, 2))
    Next
    With Sheets("outward").Cells(1).CurrentRegion
        .Sort key1:=.Cells(1, 2), order1:=1, Header:=xlYes
        .Offset(1, 6).ClearContents
        For i = 2 To .Rows.Count
            txt = Join$(Array(.Cells(i, 3).Value, .Cells(i, 4).Value, .Cells(i, 5).Value), Chr(2))
            CD = .Cells(i, 6).Value
            If dic.exists(txt) Then
                n = 0
                For Each e In dic(txt)
                    w = dic(txt)(e)
                    If w(2) <= .Cells(i, 2).Value Then
                        If CD > 0 Then
                            If CD <= w(0) Then
                                w(0) = w(0) - CD
                                QTY = CD
                                CD = 0
                            Else
                                QTY = w(0)
                                CD = CD - w(0)
                                w(0) = 0
                            End If
                            .Cells(i, 7 + n).Resize(, 3).Value = _
                            Array(QTY, e, QTY * w(1))
                            n = n + 3
                            dic(txt)(e) = w
                            If w(0) = 0 Then dic(txt).Remove e
                        End If
                    End If
                Next
            End If
            If CD > 0 Then
                MsgBox .Cells(i, 3) & " " & .Cells(i, 4) & vbLf & CD & " short", _
                vbCritical, Format$(.Cells(i, 2), "mmm dd yyyy")
                GoTo Exit_Sub
            End If
        Next
    End With
Exit_Sub:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

thanx buddy

Now you must mark this thread as "SOLVED".