Results 1 to 5 of 5

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

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #5
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,218
    Location
    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.
    Attached Files Attached Files
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved
    Click here for a guide on how to upload a file with your post

    Excel 365, Version 2404, Build 17531.20140

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •