Dynamically adding nested loops - excel

I have an 'X' amount of variables (likely to range between 3 to 20 options), which will be combined to calculate all possible combinations to meet a criteria. For every extra variable an extra loop is introduced, however I do not know if it possible to make the creation of loops dynamic (in excel VBA, the code doesn't have to be very fast).
To demonstrate:
I have var. A with h = 2, var. B with h = 3.
I would like to know all combinations which are equal to 10 or the best combination of the 2 variables.
In this case: option 1 = 5*A = 10, 3*B = 9,2*A and 2*B = 10, 3*A and 1*B = 9.
The code looks like this:
For A = 0 to 5
h = 0 'Reset previous h if solution is found
For B = 0 to 5
h_test = A * height(A) + B * heigth(B)
if h_test > 10
if h = 0 then
exit for
else
write h
exit for
end if
h = h_test
Next B
Next A
If another parameter is introduced (for example C = 4), the code is:
For A = 0 to 5
h = 0 'Reset previous h if solution is found
For B = 0 to 5
h = 0 'Reset previous h if solution is found
For C = 0 to 5
h_test = A * height(A) + B * heigth(B) + C * heigth(C)
if h_test > 10
if h = 0 then
exit for
else
write h
exit for
end if
h = h_test
Next C
Next B
Next A
In other words, I would like to know if it is possible to translate the pseudocode to real code:
For #parameter. = X
For loop1 = 1 to 5
h = 0
For loop2 = 1 to 5
h = 0
....
For loopX = 1 to 5
h_test = loop1 *parameter1 + loop2 * parameter 2 ...
+ loopX * parameter X
If h_test > 10
Somecode
exit for
End if
Next X
...
Next loop2
Next loop1

There are two distinct problems here. You didn't mention the first, and that is you also need to calculate a value with an indeterminate number of arguments. For that, you can use a ParamArray.
For example:
Public Function Sum(ParamArray args() As Variant) As Long
Dim i As Long
Dim operand As Integer
Dim result As Long
For i = LBound(args) To UBound(args)
result = args(i) + result
Next i
Sum = result
End Function
Which can be used and tested like this:
Public Sub Test()
Debug.Print Sum(1,2) '=> 3
Debug.Print Sum(1,2,3) '=> 6
End Sub
So, that takes care of that problem. Now, as for the problem you asked about, we'll take a similar approach. The key is to loop once for each argument you've received.
Public Sub Run()
NestedLoop 1, 2, 3
End Sub
Public Sub NestedLoop(ParamArray args() As Variant)
Dim result As Long
Dim a As Variant
a = args
Dim h_test As Long
Dim i As Long, j As Long
For i = LBound(args) To UBound(args)
For j = 1 To 5
result = 0
h_test = Sum(a)
If h_test > 10 Then
If result = 0 Then
Exit For
Else
Debug.Print result
Exit For
End If
End If
result = h_test
Next j
Next i
End Sub
Public Function Sum(args As Variant) As Long
Dim i As Long
Dim operand As Integer
Dim result As Long
For i = LBound(args) To UBound(args)
result = args(i) + result
Next i
Sum = result
End Function

Related

Using vba function to split range into even and odd

I'm tring to write an Excel (2013) function that would take a 1x2n range of cells and return 1xn vector of cells that are of even/odd index. So if I put some numbers in cells A1:F1 as this
A
B
C
D
E
F
1
43
23
67
12
6
1
And put this function in A2:C2, it should return
A
B
C
D
E
F
1
43
23
67
12
6
1
2
23
12
1
I wrote something like this, but it doesn't work (#Arg! error)
Public Function Even(X As Variant) As Variant
Dim N As Integer
N = UBound(X)
ReDim Y(N / 2)
For i = 1 To N
If i Mod 2 = 0 Then
Y(i / 2) = X(i)
End If
Next i
Even = Y
End Function
After #BigBen comments I've changed the code to
Public Function Even(X As Variant) As Variant
Dim N As Integer
N = Application.CountA(X.Value)
ReDim Y(N / 2)
For i = 1 To N
If i Mod 2 = 0 Then
Y(i / 2) = X(i)
End If
Next i
Even = Y
End Function
It now returns almost what I want, it returns:
A
B
C
D
E
F
1
43
23
67
12
6
1
2
0
23
12
1
where's 0 coming from
Here is a possibility. EVEN is a spreadsheet function, so a different name is preferable. EveryOther seems natural, but with a name like that, why not make it flexible enough to select the odds if need be? A good way to do that is to make an optional Boolean argument which controls if even or odd indices are chosen:
Function EveryOther(Rng As Range, Optional Evens As Boolean = True) As Variant
Dim i As Long, j As Long, n As Long
Dim cell As Range
Dim returnVals As Variant
n = Rng.Cells.count
ReDim returnVals(1 To n)
i = 0
j = 0
For Each cell In Rng.Cells
i = i + 1
If i Mod 2 = IIf(Evens, 0, 1) Then
j = j + 1
returnVals(j) = cell.Value
End If
Next cell
ReDim Preserve returnVals(1 To j)
EveryOther = returnVals
End Function

Invalid Next Control Variable

I am hitting a wall with the error "Compile Error: Invalid Next Control variable reference".
Trying to skip code lines if the variable is not found in the sheet, e.g if X = 0 then skip. Can't debug step by step since it jumps straight to the error.
appreciate any 2 cents
Dim a As Integer
Dim b As Integer
Dim D As Integer
'{.......}
' a
Freight_Str_Minimum_List(1) = strFreightperMinCol:
Freight_Str_Minimum_List(2) = strFreightMinCol:
Freight_Str_Minimum_List(3) = strMOtherMinCol
' b
Freight_Col_Minimum_List(1) = FreightperMinCol:
Freight_Col_Minimum_List(2) = FreightMinCol:
Freight_Col_Minimum_List(3) = MOtherMinCol
' d
Freight_Str_PerKg_List(1) = strFreightperKgCol:
Freight_Str_PerKg_List(2) = strFreightperkgAll_InCol:
Freight_Str_PerKg_List(3) = strFreightless45All_InCol:
Freight_Str_PerKg_List(4) = strFreightgreater45All_InCol:
Freight_Str_PerKg_List(5) = strFreight100All_InCol:
' this goes until (9)
For a = 1 To 3
For b = 1 To 3
For D = 1 To 9
If Freight_Str_Minimum_List(a) = 0 Then GoTo nextsegment3
If Freight_Col_Minimum_List(b) = 0 Then GoTo nextsegment3
If Freight_Col_PerKg_List(D) = 0 Then GoTo nextsegment3
'lines of code with calculations With...end with
nextsegment3:
Next a
Next b
Next D
No Goto:
For a = 1 To 3
For b = 1 To 3
For D = 1 To 9
If Freight_Str_Minimum_List(a) <> 0 Then
If Freight_Col_Minimum_List(b) <> 0 Then
If Freight_Col_PerKg_List(D) <> 0 Then
'lines of code with calculations With...end with
End If
End If
End If
Next D
Next b
Next a

i = empty how can i solve this?

Dim a As Integer
a = 0
For i = 4 To i + 1
Set xRange = Sheets("sayfa4").Rows(i)
For j = 1 To 10
If Sheets("sayfa4").Cells(i, j) > 0 And Sheets("sayfa4").Cells(i, j) = Application.WorksheetFunction.Min(xRange) Then
a = a + 1
Sheets("sayfa4").Cells(i, j).ClearContents
Sheets("sayfa4").Cells(15 + a, 1) = i
Sheets("sayfa4").Cells(15 + a, 2) = j
i = j - 1
End If
Next j
Next i
i don't get any errors or something i just can't execute it nothing happens on excel sheet can you help me guys what is the problem
when i try with F8 it shows "i = empty"
my main problem is declaring the next i actually
when i choose a cell(i,j) and printing the value of it
my next i should be j and after i should start to search min value of j row and it turns out next i
I tryed to understand your logic and rewrote the code:
Option Explicit
Sub test()
Dim a As Integer
Dim i As Long, j As Long
Dim xRange As Range
a = 0
i = 4
For i = 4 To i + 1
Set xRange = Sheets("sayfa4").Rows(i)
For j = 1 To 10
If Sheets("sayfa4").Cells(i, j) > 0 And Sheets("sayfa4").Cells(i, j) = Application.WorksheetFunction.Min(xRange) Then
a = a + 1
'Sheets("sayfa4").Cells(i, j).ClearContents
Sheets("sayfa4").Cells(15 + a, 1) = i
Sheets("sayfa4").Cells(15 + a, 2) = j
Exit For
'i = j - 1
End If
Next j
Next i
End Sub
If you are looking for the minimum value of a selection, this code should solve your issue
This statement is meaningless
For i = 4 To i + 1
this is because i is uninitialized or zero and so the loop is really For i=4 to 1 which will be ignored.
If you do not know how many times to iterate use a Do Loop instead. Only use For for fixed iterations and do not alter the iteration variable inside the loop.
If you want to stop the loop use Exit For, or Exit Do and if you want to end the function or subroutine processing use Exit Function or Exit Sub.
To skip to the next iteration in VBA you would use an If structure, since it does not have a continuation keyword like other languages have. (thanks #BigBen)

Computing sums on VBA

Trying to sum 2^i from i=0 to i=n on VBA. Where n is an entered value by the user each time
I can get it to do each term individually but its not summing.
Sub Button1()
Dim n As Single
n = InputBox("Enter a value for n")
Dim array as
Dim CSeriesSum As Double
ActiveCell.Value = WorksheetFunction.SeriesSum(Arg1:=2, Arg2:=n, Arg3:=1, Arg4:=1:n)
End Sub
I expect it to return for eg. 1 if n=0, 3 if n=1, 7 if n=2 etc.
Maybe try this loop:
Sub Button1()
Dim n As Single
n = InputBox("Enter a value for n")
Dim val As Long
val = 0
For i = 0 To n
val = val + 2 ^ i
Next
ActiveCell.Value = val
End Sub
In addition to the loop-based approach, you can use the fact that the series
1 + 2 + 2^2 + ... + 2^n + ...
is a geometric series whose partial sums can be expressed in closed-form. In this case the partial sum that you are evaluating is equal to 2^(n+1)-1. For example, if n = 3, it is easy to verify that
1 + 2 + 4 + 8 = 15 = 16-1 = 2^4 - 1
This leads to the following code:
Sub Button1()
Dim n As Long
n = InputBox("Enter a value for n")
ActiveCell.Value = 2 ^ (n + 1) - 1
End Sub

Find if the number is Prime or show the prime factors using excel formula?

I have of integers in Col A and in col B i want to show result 'Prime' if it doesn't have further factors for the number itself. This goes like this if the number for example is 37 result will be 'Prime' and if its 44 then result will be 2x2x11. How can i do this using excel formula? Screen shot :
Disclaimer: code below is ported from this very useful VB.NET example
Option Explicit
Sub Test()
Debug.Print FindFactors(2)
Debug.Print FindFactors(3)
Debug.Print FindFactors(11)
Debug.Print FindFactors(12)
Debug.Print FindFactors(13)
Debug.Print FindFactors(16)
Debug.Print FindFactors(17)
Debug.Print FindFactors(24)
Debug.Print FindFactors(25)
Debug.Print FindFactors(11234)
Debug.Print FindFactors(67894)
End Sub
Function FindFactors(lngNumber As Long) As String
Dim collFactors As Collection
Dim lngFactor As Long
Dim lngCounter As Long
Dim strFactors As String
Dim strFactor As String
Set collFactors = New Collection
' Take out the 2s.
Do While (lngNumber Mod 2 = 0)
collFactors.Add 2
lngNumber = lngNumber / 2
Loop
' Take out other primes.
lngFactor = 3
Do While (lngFactor * lngFactor <= lngNumber)
If (lngNumber Mod lngFactor = 0) Then
' This is a factor.
collFactors.Add lngFactor
lngNumber = lngNumber / lngFactor
Else
' Go to the next odd number.
lngFactor = lngFactor + 2
End If
Loop
' If num is not 1, then whatever is left is prime.
If lngNumber > 1 Then
collFactors.Add lngNumber
End If
' make a string out of collection
strFactors = ""
If collFactors.Count = 1 Then
strFactors = "Prime"
Else
For lngCounter = 1 To collFactors.Count
strFactors = strFactors & collFactors(lngCounter)
If lngCounter < collFactors.Count Then
strFactors = strFactors & "x"
End If
Next lngCounter
End If
FindFactors = strFactors
End Function
Gives an output of:
Prime
Prime
Prime
2x2x3
Prime
2x2x2x2
Prime
2x2x2x3
5x5
2x41x137
2x83x409
Can be used in a worksheet:
Here is a somewhat straightforward recursive version. It is based on the idea that once you identify a factor you divide the number by that factor and then turn your attention to factoring the rest.
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "x" & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
Output:
Using LET and dynamic arrays allows for the following without VBA.
=LET(x, SEQUENCE(A1),
factors, FILTER(x, MOD(A1,x) = 0),
factorMatrix, 1 * (MOD(factors, TRANSPOSE(factors)) = 0),
primeFactors, FILTER(factors, MMULT(factorMatrix, factors ^ 0) = 2),
primeFactorList, IF(MOD(A1, primeFactors ^ SEQUENCE(1, 20)) = 0, primeFactors, ""),
factorProduct, TEXTJOIN("x",, primeFactorList),
IF(A1 = 1, "Neither", IF(factorProduct=A1&"","Prime",factorProduct)))
It works for numbers up to 2^20.
A slight modification to the excellent code of John Coleman above, using Mod with Doubles included below, will allow factoring integers up to Excel's 15 digit limit. Numbers with large factors may be noticeably slower. For example, 562,951,983,465,953 factored correctly as 16,777,259 x 33,554,467 in about 5 seconds on a Core i3.
Function Factor(ByVal n As Double, Optional FirstTrial As Double = 2) As String 'Changed
Dim i As Long
Dim t As Double 'Changed
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If FMod(t, n) = 0 Then 'Changed
.
.
.
Public Function FMod(a As Double, b As Double) As Double
FMod = a - Fix(a / b) * b
'http://en.wikipedia.org/wiki/Machine_epsilon
'Unfortunately, this function can only be accurate when `a / b` is outside [-2.22E-16,+2.22E-16]
'Without this correction, FMod(.66, .06) = 5.55111512312578E-17 when it should be 0
If FMod >= -2 ^ -52 And FMod <= 2 ^ -52 Then '+/- 2.22E-16
FMod = 0
End If
End Function

Resources