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

[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