Brining in 2 inputs incrementally & 3 others from lists.

Scot1

New Member
Joined
Mar 1, 2018
Messages
1
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

Code:
[COLOR=#333333]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
[/COLOR]
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

Code:
[COLOR=#333333]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
[/COLOR]
Above is my attempt for the modification, but I am unsure how to allow for 'q' to be brought in as intended.
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,214,644
Messages
6,120,709
Members
448,983
Latest member
Joaquim_Baptista

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top