VBA Code to Calculate Consumption Cost by Matching Company Names and Purchase Quantities

[Anbuselvam K]

Dear VBA Code Experts,

I need a VBA code to dynamically calculate the consumption cost for multiple companies based on matching company names, prices, and purchase quantities. The input data includes company names (B4) with their respective consumption quantities (C4) and company names (E4) linked to purchase prices (F4) and Purchase quantities (G4). The goal is to calculate the consumption KG's cost for each row in D4, ensuring that only the purchase data of the same company is applied to its consumption. The code should dynamically search and match company names between columns B and E, as the order of names may change in the future (e.g., AABBBABCAACCC). It must ensure that one company’s purchase data is not used for another company's cost calculation. The solution should handle any variation in the company order and deliver accurate results in D4 based on matching purchase and consumption data.

Using the Excel formula I calculated the expected cost in K4, K9, and K14 for each company A, B, and C for your reference. I need the VBA code to find the cost in D4:D18.

Thanks in Advance!

 

[Marc L]

Hello, as Excel is a calculator so why not using formulas rather than a VBA code ?!​

​

What could mean 'dynamically calculate' like 'dynamically search' as well ?​

​

 

[Anbuselvam K]

Boss, Thanks for your reply (Expect your reply)

The reason I’m asking for a VBA code is that the data can get messy over time. The company names in columns B and E won’t always be in order—they might get shuffled around (like AABBBCADDEFGDFG). If I just use formulas, I’d have to adjust them every time things change, which can get tricky and time-consuming.

Boss, No dictionary coding please @Marc L

Normal VBA code so that I can transfer to my original file.

 

[Marc L]

Formulas on all range with If company column = company row so without VBA …​

As you can also sort the data on company column.​

​

No dictionary coding please

Maybe other helper should take a slower VBA way like creating a table per company …​

Or if VBA Collections can be used instead of direct easy Dictionaries ?​

​

Just do not forget to elaborate how to compute the expected results, based on which principle ?​

​

Here obviously the easy VBA way seems to be first the Dictionary, follows the Collection …​

Why not using Dictionary ?!​

​

 

[Anbuselvam K]

Formulas on all range with If company column = company row so without VBA …As you can also sort the data on company column.

Could you include the IF statement and provide the formula that would yield the expected outcome?

Maybe other helper should take a slower VBA way like creating a table per company …Or if VBA Collections can be used instead of direct easy Dictionaries ?

I meant easy understandable codes that I can transfer to my real file.

Just do not forget to elaborate how to compute the expected results, based on which principle ?

I have already elaborated in the initial post. Should someone require further details, I will explain the specifics in response to their questions.

Here obviously the easy VBA way seems to be first the Dictionary, follows the Collection …Why not using Dictionary ?!

Certainly, a dictionary can be utilized, but it must be transferable to the actual file.

 

[Marc L]

I meant easy understandable codes that I can transfer to my real file.

As any code is understandable for who knows to read it …​

​

I have already elaborated in the initial post.

No principle name mentioned …​

​

Certainly, a dictionary can be utilized, but it must be transferable to the actual file.

So weird you have mentioned no dictionary coding as that removes the easy short procedure in this case,​

so without any Dictionary the way is to use avanced filters to create a table per company, needing a longer code …​

​

As always it depends on the explanation and the attachment : with both smart well matching the actual file there is nothing to mod.​

So it's your duty to create smart enough threads as an Excel forum is not a mind readers one …​

What could mean your 'dynamically' words in your initial post as all is static under Excel when launching a VBA procedure ?​

​

 

[Anbuselvam K]

In the initial post, I have detailed my requirements with an attachment and provided the expected results through an Excel formula. Please inform me of any additional information you need to provide the VBA code, with or without a dictionary.

 

[Marc L]

A very rare 'dynamic' sample within this forum :​

''Collision'' checking with moving objects in Excel VBA 2019

Hello Excel/VBA gurus, Some time ago I started a VBA project for a friend/client in Excel 2019. The "splash" screen was to show their logo and have moving "orbs" slowly move around it. However, the orbs needed to bounce off of each other. I thought it would be easy to do until I remembered...

chandoo.org

 

[Anbuselvam K]

I appreciate and accept that you are a genius in VBA. Could you provide the code to calculate the cost as requested in the initial post?

 

[Marc L]

I'm not a genius but just an user reading the help; it was just to show you what is 'dynamic' making Excel so slow …​

​

So your 'dynamically calculate' rather than Excel formulas should mean you wanna see something moving on a blinkering / flickering display​

like when an user selects a cell and operates something, like when using the Macro Recorder, can start with it,​

in order to avoid an efficient faster code but to just demonstrate what any user could achieve manually,​

that seems to be for some students learning Excel ?​

​

Should be the same for your 'dynamically search' meaning checking & moving cell by cell rather than using the direct efficient Excel search.​

Your both 'dynamically' making the execution lasting a while but not such a concern according to your poor data attachment …​

​

And you was right : no need to push data into any Dictionary,​

could be directly done within columns E & G just with Excel basics but modifying their data​

or if the data need to not be modified just copying those columns to helper columns …​

​

So now that 'dynamically' means clearly the slowest VBA process still is the calculation method you did not explain neither name.​

I know several cost calculation ways, hoping it's one of them …​

​

As your attachment does not match your 'explanation' you should attach a better one reflecting exactly all possible cases​

- and explaining how do you calculate manually each result if you do not know the calculation method name -​

in order you will have nothing to mod by yourself as any helper code works according to the attachment as it is​

and may not work with different layout & cases …​

​

 

[Anbuselvam K]

In the attached sheet K4, I have used a formula to calculate the consumption cost for Company A.

In the snapshot below, column D, I manually added the values from columns F and G, which represent the purchase quantity and price, to calculate the cost.

The consumption occurred in quantities of 21, 3, 5, 4, and 10.

The purchases were made as follows: 22kg at $0.5, 10kg at $0.6, and 18kg at $0.75.

The cost of consumption was calculated as follows:

21kg at $0.5 equals $10.5 (from the first purchase of 22kg, 21kg was used leaving a balance of 1kg).

1kg at $0.5 plus 2kg at $0.6 equals $1.7 (using the remaining 1kg from the first purchase and 2kg from the second purchase).

Similarly, each consumption quantity used the purchase quantity and its price.

Conditions:

- The total purchase quantity is always more than the consumption for each company.
- Company A must only use the purchases made by Company A.
- The company names in columns B and E will not be in order as shown in the attachment; they will be in a sequence like AABCBBCCAABBBCCAA.

I hope this explanation clarifies how to calculate the cost of consumption.

 

[Marc L]

Ok it just seems to be a FIFO calculation, the missing information in the initial post​

so very useless (dumb - no sense) to be 'dynamically' calculated / searched under VBA …​

​

I will give it a try following post #10 logic with beginner level Excel basics according to your initial post attachment​

so you will have to mod the VBA procedure for any difference within your actual file, as guessing can't be coding.​

​

 

[Anbuselvam K]

Boss, thanks for your response!

I totally get what you're saying. Yes, it’s basically a FIFO-style calculation, and I see why it might feel unnecessary to use VBA for it. The reason I was aiming for a VBA approach is because the data I’m working with can change frequently – company names can appear in any order, and I need the matching of consumption, price, and quantity to be automated. I don’t want to risk errors or spend time constantly adjusting formulas when the data shifts.

With the formulas in my post, I’ve managed to get the right results, but only when things stay in a specific order. My hope was that VBA could handle this dynamically – searching, matching, and calculating without manual effort, even if the data isn’t structured perfectly or changes unexpectedly.

I really appreciate your help! If you could guide me with a basic VBA structure for this task, I’d be more than happy to modify it as needed to suit my actual file.

Thanks again for giving it a try!

 

[Marc L]

The VBA approach may have sense here for a static FIFO calculation but no sense if 'dynamically'​

- or only if you want the VBA procedure needs several minutes instead of less than a second, then just use the Macro Recorder ! -​

so ban this word on this forum ! I won't help anymore the next time I will meet this word on your threads, so confusing …​

​

 

[Marc L]

So according to the initial post attachment a static Excel basics VBA demonstration for starters :​

Sub Demo1()
          Dim D@(), B, E, F, R&, L, M@
   With [A1].CurrentRegion.Rows
        ReDim D(4 To .Count, 0)
        B = .Columns("B:C")
        E = Evaluate(Replace("IF(G1:G#>0,E1:E#,"""")", "#", .Count))
        F = .Columns("F:G")
    For R = 4 To .Count
        L = Application.Match(B(R, 1), E, 0)
  While IsNumeric(L) And B(R, 2)
        M = Application.Min(B(R, 2), F(L, 2))
        D(R, 0) = D(R, 0) + M * F(L, 1)
        B(R, 2) = B(R, 2) - M
     If M < F(L, 2) Then
        F(L, 2) = F(L, 2) - M
     Else
        E(L, 1) = Empty
        If B(R, 2) Then L = Application.Match(B(R, 1), E, 0)
     End If
  Wend
    Next
        Range("D4:D" & .Count) = D
   End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[Anbuselvam K]

It's functioning, boss. I'll transfer it to the actual file and will return if I encounter any issues. Beyond hitting a 'like', there's not much else I can do.

 

[Marc L]

there's not much else I can do

You should be crystal clear in your next threads …​

​

 

[Anbuselvam K]

Boss, I've transferred the code to my actual file, but all the output values are zero. Please see the snapshot. I may have made some mistakes while rewriting the code. Could you please check it?

Sub Cost_Calculation()
    Dim D@(), B, E, F, R&, L, M@
    Dim wsMaster As Worksheet, wsPurchase As Worksheet
    Dim lastRowMaster As Long, lastRowPurchase As Long
    Set wsMaster = Worksheets("Master Data")
    Set wsPurchase = Worksheets("RM Purchase")
    lastRowMaster = wsMaster.Range("B8").CurrentRegion.Rows.Count
    lastRowPurchase = wsPurchase.Range("B8").CurrentRegion.Rows.Count
    ReDim D(8 To lastRowMaster, 0)
    B = wsMaster.Range("I8:I" & lastRowMaster).Value
    AH = wsMaster.Range("AH8:AH" & lastRowMaster).Value
    E = wsPurchase.Evaluate(Replace("IF(Y8:Y#>0,D8:D#,"""")", "#", lastRowPurchase))
    F = wsPurchase.Range("C8:D" & lastRowPurchase).Value
    G = wsPurchase.Range("Y8:Y" & lastRowPurchase).Value
    For R = 8 To lastRowMaster
        L = Application.Match(B(R - 7, 1), E, 0)
        While IsNumeric(L) And AH(R - 7, 1)
            M = Application.Min(AH(R - 7, 1), G(L, 1))
            D(R, 0) = D(R, 0) + M * F(L, 1)
            AH(R - 7, 1) = AH(R - 7, 1) - M
            If M < G(L, 1) Then
                G(L, 1) = G(L, 1) - M
            Else
                E(L, 1) = Empty
                If AH(R - 7, 1) Then L = Application.Match(B(R - 7, 1), E, 0)
            End If
        Wend
    Next
    wsMaster.Range("BI8:BI" & lastRowMaster).Value = D
End Sub

Master Data snapshot.


RM Purchase Snapshot

 

[Marc L]

Compare my original procedure versus your modified version in particular for the content of the array variable E,​

maybe your formula is out of scope according to the initial post attachment columns G & E …​

​

 

[Anbuselvam K]

Boss, I've just changed to `.count` at the end of the code line, but it's showing an error.

E = wsPurchase.Evaluate(Replace("IF(Y8:Y#>0,D8:D#,"""")", "#", .Count))

 

[Marc L]

Count works only with my original procedure as you do not use With statement …​

For array variable E see the original formula what columns G & E refer to then check your version at least.​

​

 

[Anbuselvam K]

I changed this and the output is zero again.

E = Evaluate(Replace("IF(Y8:Y" & wsPurchase.Rows.Count & ">0,D8:D" & wsPurchase.Rows.Count & ","""")", "#", wsPurchase.Rows.Count))

Boss, please modify the code to function correctly with my actual file.

 

[Anbuselvam K]

what columns G & E refer to

G refers Qty and E refers Comapny Name

So the real file Y refers to Qty and C refers to Company name.

But still output prints Zero in all cells.

Sub Cost_Calculation()
    Dim D@(), B, E, F, R&, L, M@
    Dim wsMaster As Worksheet, wsPurchase As Worksheet
    Dim lastRowMaster As Long, lastRowPurchase As Long
    Set wsMaster = Worksheets("Master Data")
    Set wsPurchase = Worksheets("RM Purchase")
    lastRowMaster = wsMaster.Range("B8").CurrentRegion.Rows.Count
    lastRowPurchase = wsPurchase.Range("B8").CurrentRegion.Rows.Count
    ReDim D(8 To lastRowMaster, 0)
    B = wsMaster.Range("I8:I" & lastRowMaster).Value
    AH = wsMaster.Range("AH8:AH" & lastRowMaster).Value
    E = Evaluate(Replace("IF(Y8:Y" & wsPurchase.Rows.Count & ">0,C8:C" & wsPurchase.Rows.Count & ","""")", "#", wsPurchase.Rows.Count))
    F = wsPurchase.Range("C8:D" & lastRowPurchase).Value
    G = wsPurchase.Range("Y8:Y" & lastRowPurchase).Value
    For R = 8 To lastRowMaster
        L = Application.Match(B(R - 7, 1), E, 0)
        While IsNumeric(L) And AH(R - 7, 1)
            M = Application.Min(AH(R - 7, 1), G(L, 1))
            D(R, 0) = D(R, 0) + M * F(L, 1)
            AH(R - 7, 1) = AH(R - 7, 1) - M
            If M < G(L, 1) Then
                G(L, 1) = G(L, 1) - M
            Else
                E(L, 1) = Empty
                If AH(R - 7, 1) Then L = Application.Match(B(R - 7, 1), E, 0)
            End If
        Wend
    Next
    wsMaster.Range("BI8:BI" & lastRowMaster).Value = D
End Sub

 

[Marc L]

As your attachment does not match your 'explanation' you should attach a better one reflecting exactly all possible cases in order you will have nothing to mod by yourself as any helper code works according to the attachment as it is and may not work with different layout & cases …

As your code does not match your file so check each variable content in debug mode.​

​

Your wsPurchase.Rows.Count means calculation on one million rows, no sense !​

And you forgot to point the worksheet for your Evaluate formula …​

You can only find your errors by checking the variables contents.​

​