PDA

View Full Version : [SOLVED] Brining in 2 inputs incrementally & 3 others from lists.



Itakeyokes
03-01-2018, 03:34 AM
Hi,

I have the following code which brings in 2 inputs (v, q) incrementally (max, min and inc values specified in workbook) and also brings in 2 other inputs from lists (d and Fs, stated in workbook columns) in the following fashion. There are 3 values of v and q, and 5 values for d and Fs. So there are 45 solutions (3 * 3 * 5) as d and Fs change at the same time.

v1 d1 Fs1 q1
v2 d1 Fs1 q1
v3 d1 Fs1 q1
v1 d2 Fs2 q1
v2 d2 Fs2 q1
v3 d2 Fs2 q1
v1 d3 Fs3 q1
v2 d3 Fs3 q1
v3 d3 Fs3 q1
v1 d4 Fs4 q1
v2 d4 Fs4 q1
v3 d4 Fs4 q1
v1 d5 Fs5 q1
v2 d5 Fs5 q1
v3 d5 Fs5 q1
v1 d1 Fs1 q2
v2 d1 Fs1 q2
v3 d1 Fs1 q2
v1 d2 Fs2 q2
v2 d2 Fs2 q2
v3 d2 Fs2 q2
v1 d3 Fs3 q2
v2 d3 Fs3 q2
v3 d3 Fs3 q2
v1 d4 Fs4 q2
v2 d4 Fs4 q2
v3 d4 Fs4 q2
v1 d5 Fs5 q2
v2 d5 Fs5 q2
v3 d5 Fs5 q2
v1 d1 Fs1 q3
v2 d1 Fs1 q3
v3 d1 Fs1 q3
v1 d2 Fs2 q3
v2 d2 Fs2 q3
v3 d2 Fs2 q3
v1 d3 Fs3 q3
v2 d3 Fs3 q3
v3 d3 Fs3 q3
v1 d4 Fs4 q3
v2 d4 Fs4 q3
v3 d4 Fs4 q3
v1 d5 Fs5 q3
v2 d5 Fs5 q3
v3 d5 Fs5 q3




Function valzArrayExp1(lMin As Double, lMax As Double, lInc As Double) As Variant

Dim i As Long
Dim TempArr As Variant

ReDim TempArr(0 To (lMax - lMin) / lInc)

For i = 0 To UBound(TempArr)
TempArr(i) = lMin + lInc * i
Next
valzArrayExp1 = TempArr

End Function


Sub Test()

Dim vValz, qValz, answers, v, q, inarr, d, Fs, dValz, FsValz
Dim k As Double
Dim A As Double
Dim i As Long

With Worksheets(1)
A = .Range("C7")
B = .Range("C8")
E = .Range("C9")
F = .Range("C6")
G = .Range("C12")
dValz = .Range("H4:H8").Value
FsValz = .Range("M4:M8").Value
vValz = valzArrayExp1(.Range("F5"), .Range("F4"), .Range("F6"))
qValz = valzArrayExp1(.Range("F17"), .Range("F16"), .Range("F18"))
End With

ReDim answers(1 To (UBound(vValz) + 1) * (UBound(qValz) + 1) * UBound(dValz), 1 To 1)

For Each q In qValz
For i = 1 To UBound(dValz)
d = dValz(i, 1)
Fs = FsValz(i, 1)
For Each v In vValz
k = k + 1
If d <> 0 Then answers(k, 1) = ((A - B) / (A + 2 * B)) * ((Fs * q ^ 2) / (3 * ([Pi()] ^ 2) * E * d * (F ^ 2) * G * v))
Next v, i, q

Range("K4").Resize(UBound(answers, 1)) = answers

End Sub



This code works at intended. However, I wish to modify it so there is now an extra term being brought in from a list, but not at the same time as before. The inputs should be brought in as follows (where v and E are brought in incrementally, d and Fs are brought in at the same time from different lists, and q is brought in from a separate list at different times).

v1 d1 Fs1 q1 E1
v2 d1 Fs1 q1 E1
v3 d1 Fs1 q1 E1
v1 d2 Fs2 q2 E1
v2 d2 Fs2 q2 E1
v3 d2 Fs2 q2 E1
v1 d3 Fs3 q3 E1
v2 d3 Fs3 q3 E1
v3 d3 Fs3 q3 E1
v1 d4 Fs4 q4 E1
v2 d4 Fs4 q4 E1
v3 d4 Fs4 q4 E1
v1 d5 Fs5 q5 E1
v2 d5 Fs5 q5 E1
v3 d5 Fs5 q5 E1
v1 d1 Fs1 q6 E2
v2 d1 Fs1 q6 E2
v3 d1 Fs1 q6 E2
v1 d2 Fs2 q7 E2
v2 d2 Fs2 q7 E2
v3 d2 Fs2 q7 E2
v1 d3 Fs3 q8 E2
v2 d3 Fs3 q8 E2
v3 d3 Fs3 q8 E2
v1 d4 Fs4 q9 E2
v2 d4 Fs4 q9 E2
v3 d4 Fs4 q9 E2
v1 d5 Fs5 q10 E2
v2 d5 Fs5 q10 E2
v3 d5 Fs5 q10 E2
v1 d1 Fs1 q11 E3
v2 d1 Fs1 q11 E3
v3 d1 Fs1 q11 E3
v1 d2 Fs2 q12 E3
v2 d2 Fs2 q12 E3
v3 d2 Fs2 q12 E3
v1 d3 Fs3 q13 E3
v2 d3 Fs3 q13 E3
v3 d3 Fs3 q13 E3
v1 d4 Fs4 q14 E3
v2 d4 Fs4 q14 E3
v3 d4 Fs4 q14 E3
v1 d5 Fs5 q15 E3
v2 d5 Fs5 q15 E3
v3 d5 Fs5 q15 E3




Function valzArrayExp1(lMin As Double, lMax As Double, lInc As Double) As Variant

Dim i As Long
Dim TempArr As Variant

ReDim TempArr(0 To (lMax - lMin) / lInc)

For i = 0 To UBound(TempArr)
TempArr(i) = lMin + lInc * i
Next
valzArrayExp1 = TempArr

End Function

Sub Test()
Dim vValz, EValz, answers, v, E, inarr, d, Fs, q, dValz, FsValz, qValz
Dim k As Double, i As Long, A As Double, C As Double, X As Double, F As Double, G As Double, H As Double


With Worksheets(1)
A = .Range("C11")
C = .Range("C7")
X = .Range("C10")
F = .Range("C4")
G = .Range("C8")
H = .Range("C6")
dValz = .Range("AL4:AL8").Value
FsValz = .Range("AK4:AK8").Value
qValz = .Range("AJ4:AJ18").Value
vValz = valzArrayExp1(.Range("F5"), .Range("F4"), .Range("F6"))
EValz = valzArrayExp1(.Range("F13"), .Range("F12"), .Range("F14"))
End With

ReDim answers(1 To (UBound(vValz) + 1) * (UBound(EValz) + 1) * UBound(dValz) * UBound(qValz), 1 To 1)

For Each E In EValz
For i = 1 To UBound(dValz)
d = dValz(i, 1)
Fs = FsValz(i, 1)
For Each v In vValz
For i = 1 To UBound(qValz)
q = qValz(i, 1)
k = k + 1
If d <> 0 Then answers(k, 1) = ((A / Fs) * (C / q) * X) / (F + G + H - (v * E))
next q, i, v

Range("AR4").Resize(UBound(answers, 1)) = answers

End Sub


Above is my attempt for the modification, but I am unsure how to allow for 'q' to be brought in as intended.

p45cal
03-02-2018, 03:44 AM
I'm trying to get my head around the code which works before trying to remedy the newer code, but it's confusing as values clearly aren't in the same places.
Could you provide a workbook where there's only your first code and data in the right places on the sheet so that it's working as was intended. This'll help me work through step by step what's happpening. Then I should be able to suggest what to do.

p45cal
03-02-2018, 05:38 AM
This is very confusing.
In your second sequence, q6 is never paired with E1.
Is that correct?

Itakeyokes
03-02-2018, 06:23 AM
Hi,

Here is a workbook solely for version 1.

It works as intended, run the script.

p45cal
03-02-2018, 06:51 AM
And this?:
This is very confusing.
In your second sequence, q6 is never paired with E1.
Is that correct?

Itakeyokes
03-02-2018, 06:56 AM
Hi,
Yes you are correct. q1 to q5 are for E1, q6 to q10 are for E2, and q11 to q15 are for E3.

The reason q can not be brought in as d and Fs are is that the list 'q' already has the corresponding version of E (E1, E2, E3) incorporated into it. The worksheet I provided has arbitrary values inserted, in reality each list is governed by further equations.

Itakeyokes
03-02-2018, 07:02 AM
The second version should work as the first version does, but it should also bring in q1-5 with E1, q6-10 with E2, and q11-15 with E3.

p45cal
03-02-2018, 07:22 AM
I can see that there'll always be 15 members of q due to the hard-coded qValz = .Range("AJ4:AJ18").Value (or qValz = .Range("O4:O18").Value depending on which version).
Will there always be only 3 members of E?
[Currently this is decided by:
EValz = valzArrayExp1(.Range("F13"), .Range("F12"), .Range("F14"))
and the values in cells F12:F14 result in 3 members, but if those values were different you could have more or fewer members of E.]

p45cal
03-02-2018, 07:47 AM
Assuming there'll always be 3 members of E, try rhe following:
Sub Test()
Dim vValz, EValz, answers, v, Eval, inarr, d, Fs, q, dValz, FsValz, qValz
Dim k As Double, i As Long, EConst As Double, Ec As Double, QConst As Double, HConst As Double, Ef As Double, dc As Double
With Worksheets(1)
EConst = .Range("C11") 'E
Ec = .Range("C7")
QConst = .Range("C10")
HConst = .Range("C4")
Ef = .Range("C8")
dc = .Range("C6")
dValz = .Range("M4:M8").Value
FsValz = .Range("N4:N8").Value
qValz = .Range("O4:O18").Value
vValz = valzArrayExp1(.Range("F5"), .Range("F4"), .Range("F6"))
EValz = valzArrayExp1(.Range("F13"), .Range("F12"), .Range("F14"))
End With

ReDim answers(1 To (UBound(vValz) + 1) * (UBound(EValz) + 1) * UBound(dValz) * UBound(qValz), 1 To 1)
For i = 1 To UBound(dValz)
d = dValz(i, 1)
If d <> 0 Then
Fs = FsValz(i, 1)
For j = 1 To UBound(qValz)
'Debug.Print j, (j - 1) \ 5 'debug line
q = qValz(j, 1)
vv = 0 'debug line
For Each v In vValz
vv = vv + 1 'debug line
k = k + 1
answers(k, 1) = ((EConst / Fs) * (Ec / q) * QConst) / (HConst + Ef + dc - (v * EValz((j - 1) \ 5)))
Debug.Print "v" & vv & " d" & i & " Fs" & i & " q" & j & " E" & ((j - 1) \ 5) + 1 'debug line
Next v
Next j
End If
Next i
Range("J4").Resize(UBound(answers, 1)) = answers
End Sub
I changed some variable names since they were very confusing to me.
There's a debug.print line which prints out to the Immediate pane a sequence which seems to be the same as your second sequence in msg#1.
I haven't reduced the size of your answers array (it's 3 times too big, but it shouldn't matter).
Any line with 'debug line at the end can be deleted.
Note the reversed division operator in EValz((j - 1) \ 5) is deliberate.

Itakeyokes
03-02-2018, 07:50 AM
Both v and E currently have 3 members, but that can change depending on the max, min, inc values.

The number of values in the lists (Fs & d) can also change, but I was unsure how to factor this into the code so was planning on updating it manually each time.

It is possible for the number of members of Fs and d to change depending on their inputs. They have a further term within them not included here, that changes incrementally.

For example, changing the inputs for Fs and d could result in 6 members of each. This would mean the function would run as before, but now there would be 54 solutions. ( v =3, Fs = 6, E = 3, 3 * 6 *3). This would also mean that there would be 18 q values, as (not shown in worksheet) q's value depends on E and the same input that changes with Fs & d.

If the number of E members then rose to 4, there would be 72 solutions ( v =3, d & Fs = 6, E = 4). E now having 4 members would mean that there would be 24 individual q values.

The number of values in the columns for Fs, d and q automatically update depending on their inputs. I am now trying to get the number of solutions from this relationship to factor in all of these potential changes.

I know I am being confusing but I am terrible at trying to explain things, if there is anything I can provide to make things easier please say

thanks,
HU

Itakeyokes
03-02-2018, 07:58 AM
The code you've provided produces 225 solutions, the number of solutions desired for the situation is 45.

It is desired for the inputs to be inputted in the following 45 sets.

v1 d1 Fs1 q1 E1
v2 d1 Fs1 q1 E1
v3 d1 Fs1 q1 E1
v1 d2 Fs2 q2 E1
v2 d2 Fs2 q2 E1
v3 d2 Fs2 q2 E1
v1 d3 Fs3 q3 E1
v2 d3 Fs3 q3 E1
v3 d3 Fs3 q3 E1
v1 d4 Fs4 q4 E1
v2 d4 Fs4 q4 E1
v3 d4 Fs4 q4 E1
v1 d5 Fs5 q5 E1
v2 d5 Fs5 q5 E1
v3 d5 Fs5 q5 E1
v1 d1 Fs1 q6 E2
v2 d1 Fs1 q6 E2
v3 d1 Fs1 q6 E2
v1 d2 Fs2 q7 E2
v2 d2 Fs2 q7 E2
v3 d2 Fs2 q7 E2
v1 d3 Fs3 q8 E2
v2 d3 Fs3 q8 E2
v3 d3 Fs3 q8 E2
v1 d4 Fs4 q9 E2
v2 d4 Fs4 q9 E2
v3 d4 Fs4 q9 E2
v1 d5 Fs5 q10 E2
v2 d5 Fs5 q10 E2
v3 d5 Fs5 q10 E2
v1 d1 Fs1 q11 E3
v2 d1 Fs1 q11 E3
v3 d1 Fs1 q11 E3
v1 d2 Fs2 q12 E3
v2 d2 Fs2 q12 E3
v3 d2 Fs2 q12 E3
v1 d3 Fs3 q13 E3
v2 d3 Fs3 q13 E3
v3 d3 Fs3 q13 E3
v1 d4 Fs4 q14 E3
v2 d4 Fs4 q14 E3
v3 d4 Fs4 q14 E3
v1 d5 Fs5 q15 E3
v2 d5 Fs5 q15 E3
v3 d5 Fs5 q15 E3

p45cal
03-02-2018, 08:09 AM
The 5 in EValz((j - 1) \ 5) is the number of members in q divided by the number of members in E. As long as this comes to a whole number there should not be a problem replacing that hard-coded 5 with a variable determined after EValz and qValz have been established
zz=ubound(qValz)/((ubound(EValz)-lbound(Evalz))+1)
and later using it:
EValz((j - 1) \ zz)

Itakeyokes
03-02-2018, 08:13 AM
Yes, as q will be a multiple of E this will work for that particular issue. Thank you.

Itakeyokes
03-02-2018, 08:51 AM
Hi p45cal,

The solution you have provided does indeed bring all of the inputs into play, but not in the way desired.
The inputs for this case should only produce 45 solutions. Could you please suggest a way to modify it to meet that aim?

Thanks,
HU

p45cal
03-02-2018, 10:01 AM
I'm looking at it, but not 'full time'!
I'll get back to you.

p45cal
03-02-2018, 10:54 AM
Try:
Sub Test()
Dim vValz, EValz, answers, v, d, q, dValz, FsValz, qValz, e
Dim k As Double, EConst As Double, Ec As Double, QConst As Double, HConst As Double, Ef As Double, dc As Double
With Worksheets(1)
EConst = .Range("C11")
Ec = .Range("C7")
QConst = .Range("C10")
HConst = .Range("C4")
Ef = .Range("C8")
dc = .Range("C6")
dValz = .Range("M4:M8").Value
FsValz = .Range("N4:N8").Value
qValz = .Range("O4:O18").Value
vValz = valzArrayExp1(.Range("F5"), .Range("F4"), .Range("F6"))
EValz = valzArrayExp1(.Range("F13"), .Range("F12"), .Range("F14"))

ReDim answers(1 To (UBound(vValz) + 1) * (UBound(EValz) + 1) * UBound(dValz) * UBound(qValz), 1 To 1)
q = 1
For e = LBound(EValz) To UBound(EValz)
For d = LBound(dValz) To UBound(dValz)
If dValz(d, 1) <> 0 Then
For v = LBound(vValz) To UBound(vValz)
Debug.Print "v" & v + 1, "d" & d, "Fs" & d, "q" & q, "E" & e + 1
k = k + 1
answers(k, 1) = ((EConst / FsValz(d, 1)) * (Ec / qValz(q, 1)) * QConst) / (HConst + Ef + dc - (vValz(v) * EValz(e)))
Next v
q = q + 1 'not sure if this should be after the End If??
End If
Next d
Next e

.Range("J4").Resize(UBound(answers, 1)) = answers
End With
End SubCheck out comments in code re q and you can delete debug.print line.


Oops:

ReDim answers(1 To (UBound(EValz) - LBound(EValz) + 1) * (UBound(dValz) - LBound(dValz) + 1) * (UBound(vValz) - LBound(vValz) + 1), 1 To 1)

Itakeyokes
03-03-2018, 03:35 AM
Thank you very much kind Sir!! This solves the issue :)

Itakeyokes
03-03-2018, 02:53 PM
Hi P45cal,

I changed the values of the inputs and the relationship between them, this has caused the code to produce 15 solutions that repeat 3 times, rather than producing 45 individual solutions. I also added a new term, t, that is inputted in a similar fashion to d & Fs.




Function valzArrayExp1(lMin As Double, lMax As Double, lInc As Double) As Variant

Dim i As Long
Dim TempArr As Variant

ReDim TempArr(0 To (lMax - lMin) / lInc)

For i = 0 To UBound(TempArr)
TempArr(i) = lMin + lInc * i
Next
valzArrayExp1 = TempArr

End Function








Sub Test1()
Dim vValz, EValz, answers, v, d, q, dValz, FsValz, tValz, qValz, e
Dim k As Double, EConst As Double, Ec As Double, QConst As Double, HConst As Double, Ef As Double, dc As Double
With Worksheets(1)
Ec = .Range("C7")
QConst = .Range("C10")
Ef = .Range("C8")
dc = .Range("C6")
dValz = .Range("AL4:AL8").Value
FsValz = .Range("AK4:AK8").Value
tValz = .Range("AM4:AM8").Value
qValz = .Range("AJ4:AJ18").Value
vValz = valzArrayExp1(.Range("F5"), .Range("F4"), .Range("F6"))
EValz = valzArrayExp1(.Range("F13"), .Range("F12"), .Range("F14"))


ReDim answers(1 To (UBound(EValz) - LBound(EValz) + 1) * (UBound(dValz) - LBound(dValz) + 1) * (UBound(vValz) - LBound(vValz) + 1), 1 To 1)
q = 1
For e = LBound(EValz) To UBound(EValz)
For d = LBound(dValz) To UBound(dValz)
If dValz(d, 1) <> 0 Then
For v = LBound(vValz) To UBound(vValz)
Debug.Print "v" & v + 1, "d" & d, "Fs" & d, "t" & d, "q" & q, "E" & e + 1
k = k + 1
answers(k, 1) = ((dValz(d, 1) * FsValz(d, 1) * EValz(e) * qValz(q, 1)) / vValz(v)) * (((Ec - 1) / (Ec + 1)) * tValz(d, 1) + 1 / tValz(d, 1)) - ((dValz(d, 1) * FsValz(d, 1) * QConst * qValz(q, 1)) / (2 * Ef * vValz(v) * (dc / 2)))
Next v
q = q + 1
End If
Next d
Next e

.Range("J4").Resize(UBound(answers, 1)) = answers
End With
End Sub




I can not figure out why these small changes have changed the code's function. Could you please have a look?


v1 d1 Fs1 t1 q1 E1
v2 d1 Fs1 t1 q1 E1
v3 d1 Fs1 t1 q1 E1
v1 d2 Fs2 t2 q2 E1
v2 d2 Fs2 t2 q2 E1
v3 d2 Fs2 t2 q2 E1
v1 d3 Fs3 t3 q3 E1
v2 d3 Fs3 t3 q3 E1
v3 d3 Fs3 t3 q3 E1
v1 d4 Fs4 t4 q4 E1
v2 d4 Fs4 t4 q4 E1
v3 d4 Fs4 t4 q4 E1
v1 d5 Fs5 t5 q5 E1
v2 d5 Fs5 t5 q5 E1
v3 d5 Fs5 t5 q5 E1
v1 d1 Fs1 t1 q6 E2
v2 d1 Fs1 t1 q6 E2
v3 d1 Fs1 t1 q6 E2
v1 d2 Fs2 t2 q7 E2
v2 d2 Fs2 t2 q7 E2
v3 d2 Fs2 t2 q7 E2
v1 d3 Fs3 t3 q8 E2
v2 d3 Fs3 t3 q8 E2
v3 d3 Fs3 t3 q8 E2
v1 d4 Fs4 t4 q9 E2
v2 d4 Fs4 t4 q9 E2
v3 d4 Fs4 t4 q9 E2
v1 d5 Fs5 t5 q10 E2
v2 d5 Fs5 t5 q10 E2
v3 d5 Fs5 t5 q10 E2
v1 d1 Fs1 t1 q11 E3
v2 d1 Fs1 t1 q11 E3
v3 d1 Fs1 t1 q11 E3
v1 d2 Fs2 t2 q12 E3
v2 d2 Fs2 t2 q12 E3
v3 d2 Fs2 t2 q12 E3
v1 d3 Fs3 t3 q13 E3
v2 d3 Fs3 t3 q13 E3
v3 d3 Fs3 t3 q13 E3
v1 d4 Fs4 t4 q14 E3
v2 d4 Fs4 t4 q14 E3
v3 d4 Fs4 t4 q14 E3
v1 d5 Fs5 t5 q15 E3
v2 d5 Fs5 t5 q15 E3
v3 d5 Fs5 t5 q15 E3


Thanks,
ITY

Itakeyokes
03-04-2018, 04:53 AM
I have managed to solve this issue!