Consulting

Results 1 to 12 of 12

Thread: Help with equation that has several inputs which vary in value.

  1. #1

    Exclamation Help with equation that has several inputs which vary in value.

    Hi,

    I have an equation in VBA as follows:

    answer = A * B * C * ((1 - D) ^ (3 / 2) * (1 + E * (1 - F) ^ 3) / G ^ 2)

    where A, B, D, E, F & G are defined in a worksheet and are brought in using Worksheets(1).Range("B2") for example. This works fine for the purpose.

    However, C and G both have minimum and maximum values. I wish to input them incrementally into the above equation.

    For example:
    Cmin = 0, Cmax = 6, Increment = 2. Here I have 4 inputs (0, 2, 4, 6)
    Gmin = 0, Gmax = 3, Increment = 1. Here I have 4 inputs (0, 1, 2, 3)

    This means I will have 16 different solutions to the problem.

    I could set up the equation 16 times, but this is not efficient.

    How can I incorporate some function, maybe some sort of matrix perhaps, so that running the equation once will result in 16 answers being produced.

    Any tips, pointers etc will be much appreciated.

    Best Regards,
    ITY

  2. #2
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    if G is zero it will throw run-time error 11, "Division by 0"

    i have created a UDF to include all C and G values in an array based on min, max and increment numbers.
    you should test it with different possible values.
    i don't find it reliable even it worked with your example values.

    this is the udf:
    Function valzArray(min As Long, max As Long, inc As Long)
    
        Dim i As Long, num As Long
        Dim TempArr As Variant
        
        num = max \ inc
        ReDim TempArr(num)
        
        For i = 0 To num
            TempArr(i) = min + inc * i
        Next
        
        valzArray = TempArr
    
    
    End Function
    it worked with your example numbers

    this is a sample code to test the udf:
    Sub test()
    
        Dim tArr As Variant
        
        tArr = valzArray(0, 3, 1)
        
        For i = LBound(tArr) To UBound(tArr)
            Debug.Print tArr(i)
        Next
    
    End Sub
    and this my code for your requirement so far...
    Sub vbax_61997_array_elements_input_equation()
    
        Dim cValz, gValz, answers
        Dim cElements As Long, gElements As Long
        Dim i As Long, j As Long, k As Long
        
        Dim A As Double, B As Double, D As Double, E As Double, F As Double
        
        A = 1
        B = 2
        D = 0.04
        E = 5
        F = 0.06
        
        cValz = valzArray(0, 3, 1)
        gValz = valzArray(0, 6, 2)
        
        cElements = UBound(cValz) + 1
        gElements = UBound(gValz) + 1
        
        ReDim answers(cElements * cElements - 1)
        
        For i = 0 To cElements - 1
            For j = 0 To gElements - 1
                On Error Resume Next
                answers(k) = A * B * cValz(i) * ((1 - D) ^ (3 / 2) * (1 + E * (1 - F) ^ 3) / gValz(j) ^ 2)
                If Err Then
                    Err.Clear
                    answers(k) = 0 'when G is 0 you'll get RTE 11, division by 0. when this is the case make the answer equal to 0
                End If
                k = k + 1
            Next j
        Next i
        
        Range("F1").Resize(UBound(answers) + 1) = Application.Transpose(answers) 'write the results to worksheet
    
    End Sub
    i have used many variables for better understanding...
    you may use Range("A1").Value for A, for example
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  3. #3
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    change
    ReDim answers(cElements * cElements - 1)

    to
    ReDim answers(cElements * gElements - 1)
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  4. #4
    Thank you very much.

    I modify this to meet the needs of the project. but from an initial look over the script it seems to be fit for purpose.

    I will update with any progress.

  5. #5
    As another use of this code I wish to do something similar but with only one set of varying input, i.e d ranging from 5.00E-7 to 2.05E-5 in increments of 5.00-E6

    I modified the code as follows, but when using the above values it would run with ' Run-time error '11': Division by zero ' despite the denominator not equalling zero.


    Sub array_elements_input_equation()


    Dim dValz, answers
    Dim dElements As Long
    Dim i As Long, k As Long

    Dim A As Double, B As Double, C As Double, D As Double

    A = Worksheets(1).Range("C4")
    B = Worksheets(1).Range("C5")
    C = Worksheets(1).Range("C6")
    E = Worksheets(1).Range("C7")

    dValz = valzArray(1, 10, 1)

    dElements = UBound(dValz) + 1

    ReDim answers(dElements - 1)

    For i = 0 To dElements - 1
    answers(k) = (A * B * C) / (3 * WorksheetFunction.Pi * E * dValz(i))
    If Err Then
    Err.Clear
    answers(k) = 0
    End If
    k = k + 1
    Next i

    Range("J4").Resize(UBound(answers) + 1) = Application.Transpose(answers)


    End Sub



    With larger max, min, and increment values implemented (as shown) it works.

    Any ideas on how to be able to use much smaller values?

  6. #6
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    pls enclose your code with code tags. (see #1 in my sidnature.)

    change the data types to double and integer division \ to division / :

    Function valzArrayExp(min As Double, max As Double, inc As Double)
    
        Dim i As Double, num As Double
        Dim TempArr As Variant
        
        num = max / inc
        ReDim TempArr(num)
        
        For i = 0 To num
            TempArr(i) = min + inc * i
        Next
        
        valzArrayExp = TempArr
    
    End Function
    test:
    Sub test()
    
        Dim i As Long
        Dim tArr As Variant
        
        tArr = valzArrayExp(0.0000005, 0.0000205, 0.000005)
        
        For i = LBound(tArr) To UBound(tArr)
            Debug.Print tArr(i)
        Next
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  7. #7
    Thank you good sir.

  8. #8
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    you are welcome.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  9. #9
    I have encountered a further problem.
    The final 3 solutions are resulting in errors, ie resulting in a zero value solution.

    When solving individually this does not occur.

    I edited the first part as the minimum value is no longer 0.

    Function valzArray(min As Double, max As Double, inc As Double)
    
    
        Dim i As Double, num As Double
        Dim TempArr As Variant
        
        num = (max / inc) - (min / inc)
        ReDim TempArr(num)
        
        For i = 0 To num
            TempArr(i) = min + inc * i
        Next
        
        valzArray = TempArr
    
    
    
    
    End Function


    Sub array_elements_input_equation_Image()
    
        Dim dValz, vValz, answers
        Dim dElements As Double, vElements As Double
        Dim i As Double, j As Double, k As Double
        
        Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double
        
        A = Worksheets(1).Range("C7") ' value is 2
        B = Worksheets(1).Range("C8") ' value is 3
        C = Worksheets(1).Range("C10") ' value is 5
        D = Worksheets(1).Range("C11") ' value is 6
        E = Worksheets(1).Range("C9") ' value is 4
        F = Worksheets(1).Range("C6") ' value is 11
        G = Worksheets(1).Range("C12") ' value is 7
        
        
        dValz = valzArray(Worksheets(1).Range("F9"), Worksheets(1).Range("F8"), Worksheets(1).Range("F10")) ' (0.0000005, 0.0000205, 0.000005)
        vValz = valzArray(Worksheets(1).Range("F5"), Worksheets(1).Range("F4"), Worksheets(1).Range("F6")) ' (10 , 20, 5)
        
        dElements = UBound(dValz) + 1
        vElements = UBound(vValz) + 1
        
        ReDim answers(dElements * vElements - 1)
        
        For i = 0 To dElements - 1
            For j = 0 To vElements - 1
                On Error Resume Next
                answers(k) = ((A - B) / (A + 2 * B)) * ((C * D ^ 2) / (3 * (WorksheetFunction.Pi) ^ 2 * E * dValz(i) * F ^ 2 * vValz(j)))
                If Err Then   ' an error is occuring for final 3 solutions
                    Err.Clear
                    answers(k) = 0
                End If
                k = k + 1
            Next j
        Next i
        
        Range("R4").Resize(UBound(answers) + 1) = Application.Transpose(answers)
    
    
    
    End Sub

    As there is no division by zero the error response part of the code can be removed?
    Last edited by Itakeyokes; 02-15-2018 at 08:43 AM.

  10. #10
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    Function valzArrayExp(min As Double, max As Double, inc As Double)
    
        Dim i As Double, num As Double
        Dim TempArr As Variant
        
        num = (max - min) / inc
        ReDim TempArr(num)
        
        i = 0
        Do Until i = num + 1
            TempArr(i) = min + inc * i
            i = i + 1
        Loop
        
        valzArrayExp = TempArr
    
    End Function

    Sub array_elements_input_equation_Image()
    
        Dim dValz, vValz, answers
        Dim dElements As Double, vElements As Double
        Dim i As Double, j As Double, k As Double
        
        Dim A As Double, B As Double, C As Double, D As Double, E As Double, F As Double, G As Double
        
        With Worksheets(1)
            A = .Range("C7") ' value is 2
            B = .Range("C8") ' value is 3
            C = .Range("C10") ' value is 5
            D = .Range("C11") ' value is 6
            E = .Range("C9") ' value is 4
            F = .Range("C6") ' value is 11
            G = .Range("C12") ' value is 7
            dValz = valzArrayExp(.Range("F9"), .Range("F8"), .Range("F10")) ' (0.0000005, 0.0000205, 0.000005)
            vValz = valzArrayExp(.Range("F5"), .Range("F4"), .Range("F6")) ' (10 , 20, 5)
        End With
        
        dElements = UBound(dValz) + 1
        vElements = UBound(vValz) + 1
        
        ReDim answers(dElements * vElements - 1)
        
        For i = 0 To dElements - 1
            For j = 0 To vElements - 1
                answers(k) = ((A - B) / (A + 2 * B)) * ((C * D ^ 2) / (3 * (WorksheetFunction.Pi) ^ 2 * E * dValz(i) * F ^ 2 * vValz(j)))
                If Err Then   ' an error is occuring for final 3 solutions
                    Err.Clear
                    answers(k) = 0
                End If
                k = k + 1
            Next j
        Next i
        
        Range("R4").Resize(UBound(answers) + 1) = Application.Transpose(answers)
    
    End Sub
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  11. #11
    This solves that issue.

    I have the following code which inputs a list of inputs specified in a column into an equation and then displays the set of solutions in another specified column.

    Sub test()
        
            Dim D As Double
        
            lastrow = Cells(Rows.Count, "L").End(xlUp).Row
            inarr = Range(Cells(1, 1), Cells(lastrow, 12))
            For i = 4 To lastrow
                D = inarr(i, 12)
                Cells(i, 16) = 1 + (20 * D) / 5           'example equation
            Next i
        
        End Sub
    I have combined this with the code which brings in values incrementally.
    My aim is to incorporate both codes into one function so that I can bring in a range of inputs for one part of an equation, whilst also bringing in an input rising incrementally for another part of the same equation.


     Sub array_elements_and_Changing_input_equation_Peclet_Number()
    
    
        Dim vValz, answers
        Dim vElements As Double
        Dim i As Double, k As Double
        
        Dim A As Double, D As Double
        
        With Worksheets(1)
            A = .Range("C6")
            vValz = valzArrayExp(.Range("F5"), .Range("F4"), .Range("F6"))
        End With
        
        lastrow = Cells(Rows.Count, "L").End(xlUp).Row
        inarr = Range(Cells(1, 1), Cells(lastrow, 12))
        For i2 = 4 To lastrow
            D = inarr(i2, 12)
        Next i2
        
        vElements = UBound(vValz) + 1
        
        ReDim answers(vElements - 1)
        
        For i = 0 To vElements - 1
                answers(k) = (vValz(i) * A) / D
                If Err Then
                    Err.Clear
                    answers(k) = 0
                End If
                k = k + 1
        Next i
        
        Range("M4").Resize(UBound(answers) + 1) = Application.Transpose(answers)
    
    
    End Sub
    This does not produce any errors, but it does not run as required.

    Thank you.


  12. #12
    I have solved this issue.

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
  •