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

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:

Code:

---

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:

Code:

---

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...

Code:

---

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

change
ReDim answers(cElements * cElements - 1)

to
ReDim answers(cElements * gElements - 1)

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.

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?

pls enclose your code with code tags. (see #1 in my sidnature.)

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

Code:

---

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:

Code:

---

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

---

Thank you good sir.

you are welcome.

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.

Code:

---

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

---

Code:

---

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?

Code:

---

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

---

Code:

---

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

---

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.

Code:

---


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.

Code:

---

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.

I have solved this issue.