How to assign unit cost to each sales base on FIFO

solau

New Member
Joined
Feb 7, 2016
Messages
12
Hi Dudes,

I am having this VBA task and i am facing extreme difficulties. It will be great if I can receive any suggestions/ inspiring solutions to this problem.

Basically, there are three worksheets in my excel workbook.

First,it is the purchase worksheet where the columns are as below. (I have like 10 different products, but to simplify the situation, lets assume there is only product A)

[TABLE="width: 270"]
<colgroup><col><col span="3"></colgroup><tbody>[TR]
[TD]Date[/TD]
[TD]Product[/TD]
[TD]Quantity[/TD]
[TD]Cost[/TD]
[/TR]
[TR]
[TD="align: right"]01-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]100[/TD]
[/TR]
[TR]
[TD="align: right"]02-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]130[/TD]
[/TR]
[TR]
[TD="align: right"]03-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"]90[/TD]
[/TR]
[TR]
[TD="align: right"]04-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]105[/TD]
[/TR]
</tbody>[/TABLE]

Second, it is the sales worksheet where the columns are as below.
[TABLE="width: 592"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Product[/TD]
[TD]Quantity[/TD]
[TD]Price[/TD]
[TD]Total amount[/TD]
[/TR]
[TR]
[TD="align: right"]03-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]320[/TD]
[TD="align: right"]960[/TD]
[/TR]
[TR]
[TD="align: right"]04-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]320[/TD]
[TD="align: right"]1280[/TD]
[/TR]
[TR]
[TD="align: right"]05-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]320[/TD]
[TD="align: right"]960[/TD]
[/TR]
</tbody>[/TABLE]


Third, it is the PNL sheet which extracts information from the first and second sheet and calculate the daily PNL on product A. This is where I will need the VBA codes, I am fine with the part to extract the information from first and second sheet. However, I am not able to assign costs to.

The below is the ideal look. It will extract all the sales from sheet 2 and try to assign the unit cost (column 5) base on purchase from sheet 1. The question is how i can get its unit cost (column 5) from sheet 1 base on FIFO. :rofl:

For example, the sales on 3 Jan should have a unit cost of 100 because it is from the first purchase and so is the sales on 4 Jan.

For the sales on 5 Jan, since the first purchase are all sold, its unit cost will be from the second purchase on 2 Jan and it will be 130.

[TABLE="width: 455"]
<tbody>[TR]
[TD]Date[/TD]
[TD="width: 65"]Product[/TD]
[TD="width: 65"]Quantity[/TD]
[TD="width: 65"]Unit Price[/TD]
[TD="width: 65"]Unit Cost[/TD]
[TD="width: 65"]Unit Profit[/TD]
[TD="width: 65"]Total Profit[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]03-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]320[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]220[/TD]
[TD="align: right"]660[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]04-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]320[/TD]
[TD="align: right"]100[/TD]
[TD="align: right"]220[/TD]
[TD="align: right"]440[/TD]
[/TR]
[TR]
[TD="class: xl63, align: right"]05-Jan-16[/TD]
[TD]Product A[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]320[/TD]
[TD="align: right"]130[/TD]
[TD="align: right"]190[/TD]
[TD="align: right"]760[/TD]
[/TR]
</tbody>[/TABLE]


Thank you very much for the kind help!
 
Try this:-
This is a non "Dictionary Code"
Data in sheets 1 & sheets 2, Results in sheet 3.
Code:
[COLOR=Navy]Sub[/COLOR] MG11Feb59
'[COLOR=Green][B]Non Dic Method:-[/B][/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ray(), Str [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("b" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
        [COLOR=Navy]If[/COLOR] Not Str = Dn.Value [COLOR=Navy]Then[/COLOR]
            nStr = nStr & "," & c
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]For[/COLOR] n = 1 To Dn.Offset(, 1).Value
            c = c + 1
            ReDim Preserve Ray(1 To 4, 1 To c)
            Ray(4, 1) = nStr
            Ray(1, c) = Dn.Value: Ray(2, c) = Dn.Offset(, 1).Value: Ray(3, c) = Dn.Offset(, 2)
        [COLOR=Navy]Next[/COLOR] n
    Str = Ray(1, c)
    [COLOR=Navy]Next[/COLOR] Dn

[COLOR=Navy]Dim[/COLOR] Temp [COLOR=Navy]As[/COLOR] Double, TDn [COLOR=Navy]As[/COLOR] Range, sTn [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, nRay(), p [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Sp [COLOR=Navy]As[/COLOR] Variant, nTP [COLOR=Navy]As[/COLOR] Range, s [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
    [COLOR=Navy]Set[/COLOR] nRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
c = 1
sTn = Ray(3, 1)
ReDim nRay(1 To 7, 1 To c)
    nRay(1, 1) = "Date": nRay(2, 1) = "Product": nRay(3, 1) = "Quantity": nRay(4, 1) = "Unit Price"
    nRay(5, 1) = "Unit Cost": nRay(6, 1) = "Unit Profit": nRay(7, 1) = "Total Profit"
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] nRng
[COLOR=Navy]If[/COLOR] Not nTP [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]If[/COLOR] Not nTP.Value = Dn.Offset(, 1).Value [COLOR=Navy]Then[/COLOR]
        Sp = Split(Mid(Ray(4, 1), 2), ",")
            s = s + 1
            p = Sp(s)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
c = c + 1
ReDim Preserve nRay(1 To 7, 1 To c)
        [COLOR=Navy]For[/COLOR] n = 1 To Dn.Offset(, 2).Value
            p = p + 1
            [COLOR=Navy]If[/COLOR] Not Val(sTn) = Ray(3, p) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]If[/COLOR] Not IsEmpty(nRay(1, c)) [COLOR=Navy]Then[/COLOR]
                    c = c + 1
                    ReDim Preserve nRay(1 To 7, 1 To c)
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]End[/COLOR] If
            nRay(1, c) = Dn.Value: nRay(2, c) = Dn.Offset(, 1)
            nRay(3, c) = nRay(3, c) + 1: nRay(4, c) = Dn.Offset(, 3).Value
            nRay(5, c) = Ray(3, p): nRay(6, c) = nRay(4, c) - nRay(5, c): nRay(7, c) = nRay(3, c) * nRay(4, c)
            sTn = Ray(3, p)
            [COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]Set[/COLOR] nTP = Dn.Offset(, 1)
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]With[/COLOR] Sheets("Sheet3").Range("A1").Resize(c, 7)
    .Parent.Range("A1").Resize(c).NumberFormat = "mm/dd/yyyy"
    .Value = Application.Transpose(nRay)
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Hey Mick, how sad it is ! but it is also interesting to learn about the dictionary object and I will search around to see if it is real that Mac excel does not support the dictionary.
Thanks so much for your help and teaching !
 
Upvote 0
Hey Miles, I am not sure what you mean. I have been trying really hard with the existing function/ my custom function built with VBA and I still do not manage the solve the problem....
It will be great if you can provide some detailed example to help visualise the solution.

Thanks a lot !
 
Upvote 0
Hey Miles, I am not sure what you mean. I have been trying really hard with the existing function/ my custom function built with VBA and I still do not manage the solve the problem....
It will be great if you can provide some detailed example to help visualise the solution.

Thanks a lot !

I will look for the sheet I was playing with when I made that comment. From memory I was using the vlookup with True so that it was looking at a cumulative total of sales minus one to give the unit price.
 
Upvote 0
OK I've started from scratch as the play sheet I was using is on my other machine.
Have your purchase table in A:E
Add Row to make a new Row 2
New columns:
E1: Cumulative Quantity
E2: 0
E3 and copy down: =E2+E3

F1: Mod Q Quality
F2: 0
F3+ E3+1

G1: Unit price
G2 and copy down: D3

Sales in J:O
P1: Cumulative Sales
P2: =L2
P3 and copy down: =L3+p2

Q1: unit cost
Q2 and copy down: =VLOOKUP(P2,$F$2:$G$6,2,TRUE)

I doesn't take any account of things which span two purchases. You'd need to some sort of checking on that and have multiple columns to split the purchase into two or three (or more maybe) cumulative totals within each purchase batch but I've done my knee in and the painkillers are getting in the way of thinking at the moment! :) :)

Hope that helps

Miles
 
Upvote 0
Hey Mick, sorry that I overlooked your new solution as I was struggling with the invisibility of createobject in my Mac.


I have had a look at the new solution. And I do not quite understand your first
“for loop”.....


Please see my questions started with *** within your codes.


For Each Dn In Rng
If Not Str = Dn.Value Then
nStr = nStr & "," & c *** here, you did not define what Str is (You only declared Str as string), why you are comparing Str with Dn.value ?
***also, You did not define what nStr is, what are you placing into nStr when the programme first execute the codes?
End If
For n = 1 To Dn.Offset(, 1).Value
c = c + 1 *** again, you only declared c to be long, but did not state what c is when it just first begin (like is c 1 or 2 or 3?)
ReDim Preserve Ray(1 To 4, 1 To c)
Ray(4, 1) = nStr
Ray(1, c) = Dn.Value: Ray(2, c) = Dn.Offset(, 1).Value: Ray(3, c) = Dn.Offset(, 2)
Next n
Str = Ray(1, c)
Next Dn




Thank you again for your generous help!!!! Your code seems to be working so perfectly !!!!! (i have applied to a small dataset only)
 
Upvote 0
Hey Mick,

Ah! it seems that after you have dim sth as long/ integer, its default value is 0.

I never know that and I usually put sth like the below before for loop so that i can make sure x is 0

dim x as integer

x = 0

.....

and it seems that the default value of str and nstr is "" if they have been declared as string
funny !

It kinda breaks my concepts that i have to assign some value to it before I use them for anything.

Let me execute your codes line by line to learn from them.

Thanks a lot and It is truly inspiring !
 
Upvote 0
Hi solau,
I hope this will help !!
I have tried to comment the code below, but it is not easy to convey the essence of the code.
You will see that the first bit of code creates array "Ray" (Will now show in sheet From M1) a list similar to items require as per sheet1 but with every item in column "Quantidy" having a separate line. This is to enable me to metaphorically tick them of as sheet 2 is looped through in the code.
I think its how you feel happiest whether you define the default values of integers and strings
Code:
[COLOR=Navy]Sub[/COLOR] MG14Feb17
'[COLOR=Green][B]Code with Comments[/B][/COLOR]
'[COLOR=Green][B]Basic Code[/B][/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ray(), Str [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("b" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
'[COLOR=Green][B]The first bit of code up to the "###" mark creates an array showing data as per sheet1,but with extra[/B][/COLOR]
'[COLOR=Green][B]rows based on the "Quantidy" (Column C)[/B][/COLOR]
'[COLOR=Green][B]This array acts as a list where the number of items required by sheet 2 can be[/B][/COLOR]
'[COLOR=Green][B]individually ticked off as they are looped through at Pos(2).[/B][/COLOR]
    
 [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
'[COLOR=Green][B]This "If" function creates a String, each time the "Product" changes[/B][/COLOR]
'[COLOR=Green][B]The value "c" (Row number of array Ray))adds the line number "C" to the str[/B][/COLOR]
'[COLOR=Green][B]This is used @ pos(1)to enable the "Cost" for the new product to start from[/B][/COLOR][COLOR=Green][B] the line that related to that product[/B][/COLOR]
        [COLOR=Navy]If[/COLOR] Not Str = Dn.Value [COLOR=Navy]Then[/COLOR]
            nStr = nStr & "," & c
        [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]For[/COLOR] n = 1 To Dn.Offset(, 1).Value
            c = c + 1
            ReDim Preserve Ray(1 To 5, 1 To c)
  '[COLOR=Green][B]Ray(5,1) holds the string "nStr" (Row position in ray)for the entire list of different "Products"[/B][/COLOR]
        Ray(5, 1) = nStr
        Ray(1, c) = Dn.Offset(, -1).Value: Ray(2, c) = Dn.Value: Ray(3, c) = Dn.Offset(, 1).Value: Ray(4, c) = Dn.Offset(, 2)
        [COLOR=Navy]Next[/COLOR] n


    Str = Ray(2, c)
    [COLOR=Navy]Next[/COLOR] Dn
'[COLOR=Green][B]This is the List that is used by Array "nRay" to enbale items to be ticked of[/B][/COLOR]
'[COLOR=Green][B]as they are met in the loop through Dat on sheet2.[/B][/COLOR]
Range("M1").Resize(c, 5) = Application.Transpose(Ray)
'[COLOR=Green][B]########[/B][/COLOR]
[COLOR=Navy]Dim[/COLOR] Temp [COLOR=Navy]As[/COLOR] Double, TDn [COLOR=Navy]As[/COLOR] Range, sTn [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] nRng [COLOR=Navy]As[/COLOR] Range, nRay(), p [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Sp [COLOR=Navy]As[/COLOR] Variant, nTP [COLOR=Navy]As[/COLOR] Range, s [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] fTn [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
    [COLOR=Navy]Set[/COLOR] nRng = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]End[/COLOR] With
c = 1
sTn = Ray(3, 1)
fTn = Ray(1, 1)
ReDim nRay(1 To 7, 1 To c)
    nRay(1, 1) = "Date": nRay(2, 1) = "Product": nRay(3, 1) = "Quantity": nRay(4, 1) = "Unit Price"
    nRay(5, 1) = "Unit Cost": nRay(6, 1) = "Unit Profit": nRay(7, 1) = "Total Profit"
'[COLOR=Green][B]Pos(2)[/B][/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] nRng


[COLOR=Navy]If[/COLOR] Not nTP [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
'[COLOR=Green][B]Pos(1). Gets the right product line in array "Ray"[/B][/COLOR]
  '[COLOR=Green][B]If "Product" changes in sht2 then the next "Product" position "p) is used to obtain[/B][/COLOR]
   '[COLOR=Green][B]The correct starting "Quantidy" from column "C" sht2[/B][/COLOR]
    [COLOR=Navy]If[/COLOR] Not nTP.Value = Dn.Offset(, 1).Value [COLOR=Navy]Then[/COLOR]
        Sp = Split(Mid(Ray(5, 1), 2), ",")
            s = s + 1
            p = Sp(s)
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
c = c + 1
ReDim Preserve nRay(1 To 7, 1 To c)
 
 '[COLOR=Green][B]loops through count of "Quantidy" in sht 2[/B][/COLOR]
        [COLOR=Navy]For[/COLOR] n = 1 To Dn.Offset(, 2).Value
            p = p + 1
   
   '[COLOR=Green][B]If the "Date" or "Cost" changes[/B][/COLOR]
            If Not Val(sTn) & fTn = Ray(3, p) & Ray(1, p) Then '[COLOR=Green][B]Or fTn = Ray(1, p) Then[/B][/COLOR]
                [COLOR=Navy]If[/COLOR] Not IsEmpty(nRay(1, c)) [COLOR=Navy]Then[/COLOR]
                    c = c + 1
                    ReDim Preserve nRay(1 To 7, 1 To c)
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]End[/COLOR] If
            nRay(1, c) = Dn.Value: nRay(2, c) = Dn.Offset(, 1)
            nRay(3, c) = nRay(3, c) + 1: nRay(4, c) = Dn.Offset(, 3).Value
            nRay(5, c) = Ray(3, p): nRay(6, c) = nRay(4, c) - nRay(5, c): nRay(7, c) = nRay(3, c) * nRay(4, c)
      
      '[COLOR=Green][B]"sTn" hold "Quantidy" and "fTn" hold Date in Array Ray[/B][/COLOR]
            sTn = Ray(3, p): fTn = Ray(1, p)
            [COLOR=Navy]Next[/COLOR] n


'[COLOR=Green][B]ntp set as range(Object) for "new Products" in sheet2[/B][/COLOR]
[COLOR=Navy]Set[/COLOR] nTP = Dn.Offset(, 1)
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]With[/COLOR] Sheets("Sheet3").Range("A1").Resize(c, 7)
    .Parent.Range("A1").Resize(c).NumberFormat = "mm/dd/yyyy"
    .Value = Application.Transpose(nRay)
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Sorry for the Layout , I'm working on a very small screen at the moment !!!!
Regards Mick
 
Last edited:
Upvote 0
Hey Mick! OMG you are such a nice person ! Thanks so much for working on this which tremendously facilitates my learning in this !

I will try to digest and learn form this such that I can be a better VBA user than I am!
 
Upvote 0
Hi solau
You're welcome
Don't forget to run this commented code to show the array "RAY" starting "M1", which will give you a guide to how the code works.
NB:- I have amended the code slightly to make it more robust, I don't think you will see any difference though !!!
Regrds Mick
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,209
Members
453,023
Latest member
alabaz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top