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

[Itakeyokes]

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

[mancubus]

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

[mancubus]

change
ReDim answers(cElements * cElements - 1)

to
ReDim answers(cElements * gElements - 1)

[Itakeyokes]

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.

[Itakeyokes]

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?

[mancubus]

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

[Itakeyokes]

Thank you good sir.

[mancubus]

you are welcome.

[Itakeyokes]

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?

[mancubus]

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

[Itakeyokes]

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.

[Itakeyokes]

I have solved this issue.