I would like to calculate equilibrium price and quantity using VBA but I can't. Help!

[Levus]

The function should provide the equilibrium price based on the columns: A column: BUY, B column: PRICE, C column: SELL, and should be accessible in the Excel sheet as =equilibrium(A3:C22). These columns function as a stock market, where there's a price ​(e.g., 10) at which they want to sell (e.g., 348) units and buy (e.g., 227) units.
It should cumulate the sales quantity column from bottom to top and the purchase quantity column from top to bottom, named kumbuy and kumsell respectively.
It should find the minimum individually from the two cumulative columns row by row, named kummin.
It should find where (which row) among the values of kummin is repeated, and name the found rows as kumminrep.
In the rows of kumminrep, it should find the corresponding prices from the PRICE column, named kumminrepprice.
For each row of kumminrepprice, it should take the respective element from the BUY and SELL columns, and take the maximum for each separately, then subtract the corresponding row of kummin individually.
It should find in which row the minimum of these obtained values ​​is located, and return the associated price, named equilibriumprice, and write it in the selected cell
Here is the calculation by hand;
Képernyőkép 2024-04-18 135435.jpg

[georgiboy]

I may have missed the point here and/ or overengineered the function, as you have not had a response yet I thought I would get things started. The below function has been designed based on your description above as I don't have any experience with equilibrium prices nor the stock market.

As you wanted two separate values to be returned: Price & quantity the formula has an extra part to your suggestion above:
Your suggestion:

=Equilibrium(A3:C22)

My suggestions:

=Equilibrium(A2:C21,1)
=Equilibrium(A2:C21,2)

The 1, is for price and the 2, is for quantity.

Function Equilibrium(rng As Range, z As Integer)
    Dim buyVar As Variant, priceVar As Variant, sellVar As Variant
    Dim kumBuyVar As Variant, kumSellVar As Variant, minVar As Variant
    Dim x As Long, rtb As Double, rts As Double
    Dim mPrice() As Double, mMin() As Double, y As Long


    buyVar = Application.Index(rng, , 1)
    priceVar = Application.Index(rng, , 2)
    sellVar = Application.Index(rng, , 3)


    ReDim kumBuyVar(1 To UBound(buyVar))
    For x = 1 To UBound(buyVar)
        rtb = rtb + buyVar(x, 1)
        kumBuyVar(x) = rtb
    Next x


    ReDim kumSellVar(1 To UBound(buyVar))
    For x = UBound(buyVar) To 1 Step -1
        rts = rts + sellVar(x, 1)
        kumSellVar(x) = rts
    Next x


    ReDim minVar(1 To UBound(buyVar))
    For x = 1 To UBound(buyVar)
        minVar(x) = Application.Min(kumBuyVar(x), kumSellVar(x))
    Next x
    
    For x = 1 To UBound(buyVar)
        If minVar(x) = Application.Max(minVar) Then
            ReDim Preserve mPrice(y): mPrice(y) = priceVar(x, 1)
            ReDim Preserve mMin(y): mMin(y) = minVar(x)
            y = y + 1
        End If
    Next x
    
    For x = 0 To UBound(mPrice)
        If mPrice(x) = Application.Max(mPrice) Then
            If z = 1 Then
                Equilibrium = mPrice(x)
            ElseIf z = 2 Then
                Equilibrium = mMin(x)
            End If
            Exit Function
        End If
    Next x
End Function

[Levus]

Hey there,
Thank you so much this means a lot to me, I really appreciate your help!
Hope you have a wonderful day!
Best regards,
Levi

[Levus]

So here is the problem that I sent a PM about
equilibrium problem.xlsx equilibrium problem.docx
please do check the word file because I elaborated there.

Best regards,
Levus

[georgiboy]

If I understand you correctly then the below amendment should do it:

Function Equilibrium(rng As Range, z As Integer)
    Dim buyVar As Variant, priceVar As Variant, sellVar As Variant
    Dim kumBuyVar As Variant, kumSellVar As Variant, minVar As Variant
    Dim x As Long, rtb As Double, rts As Double
    Dim mPrice() As Double, mMin() As Double, naqVar() As Double, y As Long

    buyVar = Application.Index(rng, , 1)
    priceVar = Application.Index(rng, , 2)
    sellVar = Application.Index(rng, , 3)

    ReDim kumBuyVar(1 To UBound(buyVar))
    For x = 1 To UBound(buyVar)
        rtb = rtb + buyVar(x, 1)
        kumBuyVar(x) = rtb
    Next x

    ReDim kumSellVar(1 To UBound(buyVar))
    For x = UBound(buyVar) To 1 Step -1
        rts = rts + sellVar(x, 1)
        kumSellVar(x) = rts
    Next x

    ReDim minVar(1 To UBound(buyVar))
    For x = 1 To UBound(buyVar)
        minVar(x) = Application.Min(kumBuyVar(x), kumSellVar(x))
    Next x

    For x = 1 To UBound(buyVar)
        If minVar(x) = Application.Max(minVar) Then
            ReDim Preserve mPrice(y): mPrice(y) = priceVar(x, 1)
            ReDim Preserve mMin(y): mMin(y) = minVar(x)
            ReDim Preserve naqVar(y): naqVar(y) = Application.Max(kumBuyVar(x), kumSellVar(x)) - mMin(y)
            y = y + 1
        End If
    Next x
    
    For x = 0 To UBound(mPrice)
        If naqVar(x) = Application.Min(naqVar) Then
            If z = 1 Then
                Equilibrium = mPrice(x)
            ElseIf z = 2 Then
                Equilibrium = mMin(x)
            End If
            Exit Function
        End If
    Next x
End Function

This could also be done with a formula if using Excel 365:

=LET(rng,B2:D21,
kb,SCAN(0,INDEX(rng,,1),LAMBDA(a,b,a+b)),
kst,SORT(HSTACK(ROW(rng),INDEX(rng,,3)),1,-1),
ks,SORTBY(SCAN(0,INDEX(kst,,2),LAMBDA(a,b,a+b)),INDEX(kst,,1),1),
aq,BYROW(kb&","&ks,LAMBDA(x,MIN(--TEXTBEFORE(x,","),--TEXTAFTER(x,",")))),
naq,BYROW(kb&","&ks,LAMBDA(x,MAX(--TEXTBEFORE(x,","),--TEXTAFTER(x,",")))),
tbl,HSTACK(rng,aq,naq-aq),
ftbl,FILTER(tbl,(INDEX(tbl,,4)=MAX(INDEX(tbl,,4)))*(INDEX(tbl,,5)=MIN(INDEX(tbl,,5)))),
TRANSPOSE(CHOOSECOLS(ftbl,2,4)))

File attached with both formula and updated code.