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:rofl::dunno
Here is the calculation by hand;
31530

[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
31543 31542
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.