Results 1 to 3 of 3

Thread: VBA to solve for equation based on missing variable
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA to solve for equation based on missing variable

    Hi all, first post here.

    I've been learning VBA, and I've found the best way for me is to jump into exercises I've never done before. I recently came across a problem and decided to take a shot at it. I'm trying to use VBA to solve for the equation A = (B/C)^D, where any one variable A, B, C, or D is missing, and the others are constants pulled from cells. Ideally I'd like to create a msg box where you can input a value for each variable and it'll solve for the missing variable, but baby steps lol. Any help would be appreciated! I have attached images below of what I've done so far.


    [IMG][/IMG]


    [IMG][/IMG]

  2. #2
    MrExcel MVP mikerickson's Avatar
    Join Date
    Jan 2007
    Location
    Davis CA
    Posts
    22,605
    Post Thanks / Like
    Mentioned
    20 Post(s)
    Tagged
    15 Thread(s)

    Default Re: VBA to solve for equation based on missing variable

    To find numeric solutions to formulas, it helps to put all the variables on one side of the equation.
    Instead of A = (B-C)^D, use ((B-C)^D) - A = 0.
    This algebra is best done by the user. VBA (or any programming language) doing algebra is nasty.

    If you know 3 of the variables, this becomes a function of one variable. In your example it becomes (4800-750)^2 - A.

    One way that I like to solve for zeros of an equation is to use the binary search method.
    Code:
    Sub test()
        MsgBox FindZeroBetween(-50000000, 50000000)
    End Sub
    
    Function FindZeroBetween(startLow As Double, startHigh As Double, Optional Accuracy As Double = 1e-06) As Double
        Dim Low As Double, High As Double, Mid As Double
        
        Rem clean arguments
        Accuracy = Abs(Accuracy)
        If Accuracy = 0 Then Accuracy = 1e-06
        If MyFunction(startLow) < MyFunction(startHigh) Then
            Low = startLow
            High = startHigh
        Else
            Low = startHigh
            High = startLow
        End If
        Rem check
        Select Case Sgn(MyFunction(Low) * MyFunction(High))
            Case Is = 1
            Rem both have same sign, aborth
                MsgBox "start values do not capture zero"
                Exit Function
            Case Is = 0
                Rem one of the startvalues is a zero
                If MyFunction(Low) = 0 Then
                    Mid = Low
                Else
                    Mid = High
                End If
                MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
                FindZeroBetween = Mid
                Exit Function
            Case Else
                Rem all is good
        End Select
        
        Rem binary search
        Do
            Mid = (High + Low) / 2
            Select Case MyFunction(Mid)
                Case Is < (-1 * Accuracy)
                    Rem mid becomes low
                    Low = Mid
                Case Is > Accuracy
                    Rem mid becomes high
                    High = Mid
                Case Else
                    Rem we have a solution
                    Exit Do
            End Select
        Loop Until False
        
        MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
        
        FindZeroBetween = Mid
    End Function
    
    Function MyFunction(x As Double) As Double
        MyFunction = ((4800 - 750) ^ 2) - x
    End Function
    Note that the FindZeroBetween needs two values a and b where F(a) is positive and F(b) is negative.
    Note also that binary search is limited to "nice" functions. Continous is the primary requirement, there's a whold body of literature on the limits of binary search.
    Note also that because of the way that computers store numbers, its best to look for ABS(F(x)) < delta rather then F(x)=0. Hence the Accuracy variable.

    If the function is "nice" enough, Excel can search for and find suitable start points for FindZeroBetween.

    Code:
    Sub test()
        MsgBox FindZero
    End Sub
    
    Function FindZero() As Double
        Dim EndPoint As Double
        EndPoint = 1
        Do While True
            If Sgn(MyFunction(EndPoint) * MyFunction(-1 * EndPoint)) = -1 Then
                Rem good to go
                Exit Do
            Else
                EndPoint = 2 * EndPoint
            End If
        Loop
        FindZero = FindZeroBetween(EndPoint, -1 * EndPoint)
    End Function
    
    Function FindZeroBetween(startLow As Double, startHigh As Double, Optional Accuracy As Double = 1e-06) As Double
        Dim Low As Double, High As Double, Mid As Double
        
        Rem clean arguments
        Accuracy = Abs(Accuracy)
        If Accuracy = 0 Then Accuracy = 1e-06
        If MyFunction(startLow) < MyFunction(startHigh) Then
            Low = startLow
            High = startHigh
        Else
            Low = startHigh
            High = startLow
        End If
        Rem check
        Select Case Sgn(MyFunction(Low) * MyFunction(High))
            Case Is = 1
            Rem both have same sign, aborth
                MsgBox "start values do not capture zero"
                Exit Function
            Case Is = 0
                Rem one of the startvalues is a zero
                If MyFunction(Low) = 0 Then
                    Mid = Low
                Else
                    Mid = High
                End If
                MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
                FindZeroBetween = Mid
                Exit Function
            Case Else
                Rem all is good
        End Select
        
        Rem binary search
        Do
            Mid = (High + Low) / 2
            Select Case MyFunction(Mid)
                Case Is < (-1 * Accuracy)
                    Rem mid becomes low
                    Low = Mid
                Case Is > Accuracy
                    Rem mid becomes high
                    High = Mid
                Case Else
                    Rem we have a solution
                    Exit Do
            End Select
        Loop Until False
        
        MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
        
        FindZeroBetween = Mid
    End Function
    
    Function MyFunction(x As Double) As Double
        MyFunction = ((4800 - 750) ^ 2) - x
    End Function

  3. #3
    Board Regular
    Join Date
    Dec 2013
    Posts
    102
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to solve for equation based on missing variable

    Try this macro
    Code:
    Option Explicit
    Sub SOLVE_mY_EQ()
    Dim  b, c, d
    b = Cells(5, 3)
    c = IIf(Cells(6, 3) = "" Or Not IsNumeric(Cells(6, 3)) _
        Or Cells(6, 3) = 0, 1, Cells(6, 3))
        Cells(6, 3)=c
    d = Cells(7, 3)
    
    
    Cells(4, 3) = (b / c) ^ d
    ' Or To Round To 2 digits
    'Cells(4, 3) = Round((b / c) ^ d, 2)
    End Sub
    Last edited by salim hasan; Aug 31st, 2019 at 01:08 PM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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