I want to get this table:
C|O 1 2 3 Count
A 1 1 0 2
B 0 0 1 1
C 0 0 0 0
However, with the code I have been developing I get the following result. The number of columns and rows are dynamic.
C|O 1 2 3 Count
A 1 1 0 2
B
C
Here's the code. I think the first problem is on the countRange. And the second problem is when I put the count value, I want to do as initial values b = 0 and k = 1 as well I want to advance a = a + 1 and repeat the While cycle.
Dim a As Integer
a = 0
Dim b As Integer
b = 0
Dim k As Integer
k = 1
operations = 1
Do While operations <= sh1.Range("D4").Value + 1
If sh2.Cells(12,3+b) = "Count" Then
Dim countRange As Range
Set countRange = sh2.Range(Cells(13+a, 3),Cells(13+a,3+b-1))
Dim count As Integer
count = sh2.Application.WorksheetFunction.Sum(countRange)
sh2.Cells(13+a,3+b) = count
a = a + 1
b = 0
k = 1
Else
If sh2.Cells(12+a,3+b) = operations Then
If sh2.Cells(13+a,2) = arrayC(k) Then
sh2.Cells(13+a,3+b).Value = 1
Else
sh2.Cells(13+a,3+b).Value = 0
End If
End If
operations = operations + 1
b = b + 1
k = k + 1
End If
Wend
Declare the operations variable as Dim operations as Integer = 1 and use while loop. the Do....While loop surely executes at least for single time.
Related
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
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'm trying to run a loop on 3 variables, where order doesn't matter.
The code I've tried first is the following, where nx runs through the rows, and limit is the last row of my database:
Do While n3 <= limit
Do While n2 <= limit
Do While n1 <= limit
Call Output
n1 = n1 + 1
Loop
Call Output
n2 = n2 + 1
n1 = n0
Loop
Call Output
n3 = n3 + 1
n2 = n0
n1 = n0
Loop
This allows me to test every possibility, but it does also repeat the same combination several times, which increases the runtime. This will make the code unusable if I plan on testing, let's say, 20 variables.
Any tips on how to optimize this loop?
Thank you.
Based on your comment that you do not want permutations of a given combination. Lets say we are mixing paint. We have five different colors:
white
black
yellow
blue
green
We want to mix all possible combinations of three cans, but once we have mixed
white,blue,green
we don't need any of these:
white,green,bluegreen,white,bluegreen,blue,whiteblue,green,whiteblue,white,green
because they all result in the same light teal.
First we run the loops in this staggered fashion:
Sub MixPaint()
Dim arr(1 To 5) As String
Dim i As Long, j As Long, k As Long, LL As Long
arr(1) = "white"
arr(2) = "black"
arr(3) = "blue"
arr(4) = "green"
arr(5) = "yellow"
LL = 1
For i = 1 To 3
For j = i + 1 To 4
For k = j + 1 To 5
Cells(LL, 1) = arr(i) & ":" & arr(j) & ":" & arr(k)
LL = LL + 1
Next k
Next j
Next i
End Sub
This gets us:
This removes the permuted duplicates, but it also removes combinations like:
blue,blue,white
To get these back we adjust the loops slightly:
Sub MixPaint2()
Dim arr(1 To 5) As String
Dim i As Long, j As Long, k As Long, LL As Long
arr(1) = "white"
arr(2) = "black"
arr(3) = "blue"
arr(4) = "green"
arr(5) = "yellow"
LL = 1
For i = 1 To 5
For j = i To 5
For k = j To 5
Cells(LL, 5) = arr(i) & ":" & arr(j) & ":" & arr(k)
LL = LL + 1
Next k
Next j
Next i
End Sub
Now we have:
Which may be what you are after.
If you need to loop through a table I would loop throw the rows and columns of the table, with a double for o double while, through all the cells, to avoid repeating combinations. According to your while approach this would be:
Do While row <= rowLimit
Do While col <= colLimit
'with if conditions you can make your operations
col = col +1
Loop
row = row + 1
Loop
If you need to loop through the rows independently, you dont need to the whiles to be nested, and each while can loop its row independently. If n1, n2, and n3 have dependencies with each other, you would need to explain those, so that their relation can be taken into account to exclude determined combinations from the nested loop.
However, if the order of the combination matters as far as I checked there are no combinations repeated in your loop.
This is the log of your loop for example for n1=n2=n3 and limit =2
1 0 0
0 1 0
0 0 0
1 0 0
2 0 0
3 0 0
0 1 0
1 1 0
2 1 0
3 1 0
0 2 0
1 2 0
2 2 0
3 2 0
0 3 0
0 0 1
1 0 1
2 0 1
3 0 1
0 1 1
1 1 1
2 1 1
3 1 1
0 2 1
1 2 1
2 2 1
3 2 1
0 3 1
0 0 2
1 0 2
2 0 2
3 0 2
0 1 2
1 1 2
2 1 2
3 1 2
0 2 2
1 2 2
2 2 2
3 2 2
0 3 2
But if the order does not matter and you need to loop through every n, up to the row limit, with no n value reptition, then the while loop can be independent so do not need to be nested.
So I am not sure if I have answered your question or I am missing something.
Hope that helps anyhow
I am looking to loop through Column A.
- If the next number is greater than the previous number continue (A: 0,1,2,3..).
- Do this until the next number is equal or less than (A: 0,1,2,3,4,4..).
- If number is less than(A: 0,1,2,3,4,3..). or equal, take the highest # 4 subtract lowest #0, and put the results in columnB next to the highest number.
- If the next number is equal the previous number, subtract and put the answer 0 in columnB.
- If the next number is lower than the previous number continue. Do this until the next number is equal or less than.
- If number is less than or equal, take the highest # 4 subtract lowest #0...
I am not sure If I am clear but I am thinking a loop might work for this situation. Or perhaps any other idea would be greatly appreciated. Thanks in advance.
A B
1 0
2 1
3 2
4 3
5 4 4
6 4 0
7 3
8 2
9 1
10 0 4
11 1
12 2 2
13 2 0
14 3
15 4 2
... ...
You can use dictionary... adding the row number to the key value and check the positions...
Sub YourLoop()
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
Dim i As Integer
Dim n As Integer
For i = 1 To Rows.Count
''ColumnA values
dic.Add i, Cells(i, 1).Value
Next i
Dim k1 As Integer
Dim k2 As Integer
Dim k3 As Integer
Dim k4 As Integer
Dim v1 As Integer
Dim v2 As Integer
Dim v3 As Integer
Dim v4 As Integer
Dim v As Integer
Dim c As Integer
c = 1
For Each key In dic.Keys
v = dic(key)
If c = 1 Then
''do nothing
ElseIf c = 2 Then
k1 = key - 1
v1 = dic(k1)
If v <= v1 Then
End If
ElseIf c = 3 Then
k2 = key - 2
k1 = key - 1
v1 = dic(k1)
v2 = dic(k2)
ElseIf c >= 4 And c < dic.Count Then
k4 = key - 4
k3 = key - 3
k2 = key - 2
k1 = key - 1
v1 = dic(k1)
v2 = dic(k2)
v3 = dic(k3)
v4 = dic(k4)
ElseIf c = dic.Count Then
End If
c = c + 1
Next
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