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)
Related
The original code in Box 1 and the code in Box 2 are published on this Q＆A site . But, originally written in Japanese, so I translated to English with minor modifications. Both of them seems to be intended to enumerating the combinations of r elements out of N elements. However, I don't understand the principle behind the Box1's code.
My question
How can the Box1's macro list all the combinations that choose r elements from among N elements? I want to know mathematical principles of Box1's code.
I understand the principle of Box2's code.
Note 1: The logic of the Box2 code is as follows;
Each number below 2^N-1 is written in binary notation.
Consider the bits corresponding to 2^i to be the i-th element.
Consider the i-th element as chosen if it is 1 and not chosen if it is 0.
Thus, any combination of that "selects n "or less" elements" are listed.
Only those with exactly k number of 1's are left.
Simply, Box2's logic is a logic such that only the sets which satisfies the following condition survive;
Condition: "Number of elements whose bit=1" is r.
The code in Box 1 seems to export essentially the same results, but with fewer calculations.
Actually, after much experimentation, export of the Box1's code and Box2's code are essentially same. For example, Table 1 below shows the output for N = 5 and r = 3 . It displays 0 for the elements we don't choose and 1 for the elements we do choose.
But why can the code in Box 1 output the Essentially equivalent results to Box2's code?
Table1.A list of combinations, such that choosing 3 elements out of 5 elements
You can download XLSM file having both Box1's and Box2's macro from here.
Box1.
Sub Cmb()
Dim n, r, m, i, j, c(), o()
n = 5 'Please specify the N
r = 3 'Please specify the r
m = WorksheetFunction.Combin(n, r)
ReDim c(r), o(m, n)
For j = 0 To r: c(j) = j: Next
o(0, 0) = "Decimal"
For j = 1 To n: o(0, j) = "Elements" & j: Next
i = 1
Do While c(0) <= 0
For j = 0 To n: o(i, j) = 0: Next
For j = 1 To r
o(i, 0) = o(i, 0) + 2 ^ (c(j) - 1)
o(i, n + 1 - c(j)) = 1
Next
i = i + 1
nc n, r, c
Loop
Cells(1, 1).Resize(m + 1, n + 1).Value = o
End Sub
Sub nc(n, r, ByRef c())
Dim j, k
For j = r To 0 Step -1
c(j) = c(j) + 1
For k = j + 1 To r: c(k) = c(k - 1) + 1: Next
If c(j) <= n - r + j Then Exit For
Next
End Sub
Box2.
Sub enumeration_of_combinations()
Dim table_()
n = 5
r = 3
Number_of_elements = WorksheetFunction.Combin(n, r)
ReDim table_(1 To Number_of_elements)
cnt = 1
Nmax = (2 ^ n) - 1
For i = 1 To Nmax
Number_of_bits = 0: modulo_ = i
For j = 0 To n
Quotient_ = modulo_ \ 2 ^ (n - j)
modulo_ = modulo_ Mod 2 ^ (n - j)
Number_of_bits = Number_of_bits + Quotient_
Next j
If Number_of_bits = r Then
table_(cnt) = i: cnt = cnt + 1
End If
Next i
For i = 1 To Number_of_elements
modulo_ = table_(i)
For j = 0 To n
Quotient_ = modulo_ \ 2 ^ (n - j)
modulo_ = modulo_ Mod 2 ^ (n - j)
Cells(i + 1, j + 1) = Quotient_
Next j
Cells(i + 1, 1) = table_(i)
Next i
Cells(1, 1) = "Decimal": For j = 1 To n: Cells(1, j + 1) = "element" & j: Next j
End Sub
Reference.
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14208784379 (Written in Japanese)
This is what you should do:
break all those single-line For-Next cycle to make them easily readable by you;
rename all the variables with name made of multiple letters (at least 3 each) that has some sense according to the use the code make of them. To determine it, search for them in the code and interpret it;
if the purpose of one variable is not clear, try with another one;
if you still can't figure the purpose of some of the variables, use the immediate and local window while stopping the code during its execution. With this code you can also run the code once to have the result on sheet and re-run and stop it.
write the appropriate notes.
You should end with something like this:
Sub SubCombinations()
'Declarations.
Dim TotalBits, PositiveBits, CombinationsCount, Counter01, Counter02, ExponentsArray(), ResultArray()
'Setting variables.
TotalBits = 5 'Please specify the N
PositiveBits = 3 'Please specify the r
CombinationsCount = WorksheetFunction.Combin(TotalBits, PositiveBits)
'Reallocating variables.
ReDim ExponentsArray(PositiveBits), ResultArray(CombinationsCount, TotalBits)
'Setting the starting position of the ExponentsArray. This will result in the first line having all the 1 on the right.
For Counter02 = 0 To PositiveBits
ExponentsArray(Counter02) = Counter02
Next
'Setting the headers.
ResultArray(0, 0) = "Decimal"
For Counter02 = 1 To TotalBits
ResultArray(0, Counter02) = "Elements" & Counter02
Next
'Setting variable.
Counter01 = 1
'When ExponentsArray(0) will be greater than 0, we will have covered all possible combinations.
Do While ExponentsArray(0) <= 0
'Set all the bits in the given result row as 0.
For Counter02 = 0 To TotalBits
ResultArray(Counter01, Counter02) = 0
Next
'Covering all the positive bits requested for the row.
For Counter02 = 1 To PositiveBits
'Increasing the decimal result by 2 elevated by the power of the value of attributed to the given bit.
ResultArray(Counter01, 0) = ResultArray(Counter01, 0) + 2 ^ (ExponentsArray(Counter02) - 1)
'Reporting the positive bit in its proper location on the row.
ResultArray(Counter01, TotalBits + 1 - ExponentsArray(Counter02)) = 1
Next
'Setting Counter01 to cover the next row.
Counter01 = Counter01 + 1
'Calling SubExponentsShift
SubExponentsShift TotalBits, PositiveBits, ExponentsArray
Loop
'Reporting the results.
Cells(1, 1).Resize(CombinationsCount + 1, TotalBits + 1).Value = ResultArray
End Sub
Sub SubExponentsShift(TotalBits, PositiveBits, ByRef ExponentsArray())
'Declarations.
Dim Counter01, Counter02
'Covering all the values in the ExponentsArray.
For Counter01 = PositiveBits To 0 Step -1
'Increasing the exponent value. This will make "the given bit shift to the left".
ExponentsArray(Counter01) = ExponentsArray(Counter01) + 1
'If we have "shifted" a bit that was not the first on the right, we have to correct the overshoot of the other bit "shifted" previously.
For Counter02 = Counter01 + 1 To PositiveBits
ExponentsArray(Counter02) = ExponentsArray(Counter02 - 1) + 1
Next
'If we have overshoot while "shifting the position" of the given bit, the For-Next cycle continues.
If ExponentsArray(Counter01) <= TotalBits - PositiveBits + Counter01 Then
Exit For
End If
Next
End Sub
It will then be easier to realize how the code works. The subroutine actually sets the starting conditions and produce each row of the result while the function focuses on "shifting the position" of the bits for each row of the result. Matematically speaking, the code just increase metodically the exponents of given set of powers of 2 whose result are then sum; this goes on until all the unique combinations are covered.
I got an initial code but it's not working correctly, if you guys have any suggestions on how to achieve it and make the code better (cleaner/faster) I would really appreciate it.
Sub CountByError()
Dim rangeArr() As Variant
Dim xcharFlag As Boolean
Dim tester2 As Worksheet
Set tester2 = Worksheets("tester2")
rangeArr = Worksheets("tester").Range("a2").Resize(3169, 30).Value2
Dim i As Long, j As Long
For i = 1 To 29
Select Case i
Case 1
For j = 1 To 3168
xcharFlag = False
For k = 1 To Len(rangeArr(j, i))
If Not Mid(Len(rangeArr(j, i)), k, 1) Like "[a-zA-Z0-9-]" Then
xcharFlag = True
If xcharFlag = True Then Exit For
End If
Next k
If xcharFlag = True Then
tester2.Range("d4") = tester2.Range("d4") + 1
End If
Next j
End Select
Next i
Worksheets("tester").Range("a2").Resize(3169, 30).Value2 = rangeArr
End Sub
It's always good to split the code into smaller pieces. In your case, I would suggest you move the check if a string contains invalid characters into a boolean function. That makes it much easier to test and debug.
Function containsInvalidChar(ByVal s As String) As Boolean
Dim k As Long
For k = 1 To Len(s)
If Not Mid(s, k, 1) Like "[a-zA-Z0-9-]" Then
containsInvalidChar = True
Exit Function
End If
Next k
containsInvalidChar = False
End Function
Now open the immediate window and enter something like (the TRUE and FALSE is the response).
? containsInvalidChar("ABC")
FALSE
? containsInvalidChar("12-34 56")
TRUE
? containsInvalidChar(ActiveCell)
FALSE
Once you are rather sure that the function works as expected, remove the code from your nested loops and replace it with a simple call to the function:
(...)
For j = 1 To 3168
If containsInvalidChar(rangeArr(j, i)) then
tester2.Range("d4") = tester2.Range("d4") + 1
End If
Next j
By this, you separate the logic how to identify an invalid string from the logic of how to deal with that situation. You could easily change the function to use regular expressions instead of the like (which probably would increase execution speed) without touching the rest of the code, or you could reuse the function to mark invalid words with a different color (could even be used as function in conditional formatting).
Your current check, by the way, has a superfluent Len( in the check.
This is how it should work
Sub CountByError()
Dim rangeArr() As Variant
Dim tester2 As Worksheet
Dim i As Long, j As Long, k As Long
Set tester2 = Worksheets("tester2")
rangeArr = Worksheets("tester").Range("a2").Resize(3169, 30).Value2
tester2.Range("d4") = 0
For i = LBound(rangeArr, 1) To UBound(rangeArr, 1)
For j = LBound(rangeArr, 2) To UBound(rangeArr, 2)
For k = 1 To Len(rangeArr(i, j))
If Mid(rangeArr(i, j), k, 1) Like "[!a-zA-Z0-9-]" Then
tester2.Range("d4") = tester2.Range("d4") + 1
Exit For
End If
Next k
Next j
Next i
End Sub
The macro may be slow and some changes to optimize the code may be useful.
I am trying to call a multidimensional table from one function to another one but I get the error :
Sub or Function not defined
here is what I tried :
Public Function update()
Public tabPerformance(11, 16) As Long
If (Worksheets("Feuil1").Range("E3").Value = "Performance") Then
For j = 0 To j = 1
For i = 0 To i = 1
For k = 3 To 5
For l = 6 To 8
tabPerformance(j, i) = Cells(l, k).Value
MsgBox tabPerformance(j, i)
Next l
Next k
Next i
Next j
End If
If (Worksheets("Feuil1").Range("E3").Value = "Inflation") Then
For j = 0 To j = 1
For i = 0 To i = 1
For k = 3 To 5
For l = 6 To 8
tabInflation(j, i) = Cells(l, k).Value
MsgBox tabInflation(j, i)
Next l
Next k
Next i
Next j
End If
and this is the function where I want to call the tabPerformance Table :
Public Function recap()
Dim tabPerformanceCells(11, 16) As Long
If (Worksheets("Feuil1").Range("E3").Value = "Performance") Then
For j = 0 To j = 1
For i = 0 To i = 1
For k = 3 To 5
For l = 6 To 8
Cells(l, k).Value = tabPerformance(j, i)
MsgBox Cells(l, k).Value
Next l
Next k
Next i
Next j
End If
I need to know how to properly call the tabPerformance from anywhere i want.
There are four things you should know about when developing VBA code.
Put 'Option Explicit' at the start of each Module/Class'. This will make sure that you don't get errors because of incorrect syntax of misspelled variable names.
In the VBA IDE if you press F1 when the cursor is on a VBA keyword this will bring up the MS Help Page for that feature in VBA. This should be your first port of call for any errors you see. Try this for the F'or' keyword and you will see that your syntax for the For loop is incorrect.
Before you run any code make sure you compile the whole project so that you can find errors that are not detected by Option Explicit. (Debug.Compile Project)
Install the fantastic RubberDuck addin for VBA. Its free software. RubberDuck will help keep your code nicely indented, allow you to rename things safely and produce 'Code Inspections' which is where a stricter analysis of the VBA code is done and advice is given on how to write your code more safely.
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
I have data stored in some column (Say, Column A). The length of Column A is not fixed (depends on previous steps in the code).
I need a histogram for the values in Column A, and have it in the same sheet. I need to take the values in column A, and automatically compute M Bins, then give the plot.
I looked online for a "simple" code, but all codes are really fancy, with tons of details that I don't need, to the extent that I am not even able to use it. (I am a VBA beginner.)
I found the following code that seems to do the job, but I am having trouble even calling the function. Besides, it only does computations but does not make the plot.
Sub Hist(M As Long, arr() As Single)
Dim i As Long, j As Long
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Single
For i = 1 To M
freq(i) = 0
Next i
Length = (arr(UBound(arr)) - arr(1)) / M
For i = 1 To M
breaks(i) = arr(1) + Length * i
Next i
For i = 1 To UBound(arr)
If (arr(i) <= breaks(1)) Then freq(1) = freq(1) + 1
If (arr(i) >= breaks(M - 1)) Then freq(M) = freq(M) + 1
For j = 2 To M - 1
If (arr(i) > breaks(j - 1) And arr(i) <= breaks(j)) Then freq(j) = freq(j) + 1
Next j
Next i
For i = 1 To M
Cells(i, 1) = breaks(i)
Cells(i, 2) = freq(i)
Next i
End Sub
And then I try to call it simply by:
Sub TestTrial()
Dim arr() As Variant
Dim M As Double
Dim N As Range
arr = Range("A1:A10").Value
M = 10
Hist(M, arr) ' This does not work. Gives me Error (= Expected)
End Sub
A little late but still I want to share my solution. I created a Histogram function which might be used as array formula in the excel spread sheet. Note: you must press
CTRL+SHIFT+ENTER to enter the formula into your workbook. Input is the range of values and the number M of bins for the histogram. The output range must have M rows and two columns. One column for the bin value and one column for the bin frequency.
Option Explicit
Option Base 1
Public Function Histogram(arr As Range, M As Long) As Variant
On Error GoTo ErrHandler
Dim val() As Variant
val = arr.Value
Dim i As Long, j As Integer
Dim Length As Single
ReDim breaks(M) As Single
ReDim freq(M) As Integer
Dim min As Single
min = WorksheetFunction.min(val)
Dim max As Single
max = WorksheetFunction.max(val)
Length = (max - min) / M
For i = 1 To M
breaks(i) = min + Length * i
freq(i) = 0
Next i
For i = 1 To UBound(val)
If IsNumeric(val(i, 1)) And Not IsEmpty(val(i, 1)) Then
If val(i, 1) > breaks(M) Then
freq(M) = freq(M) + 1
Else
j = Int((val(i, 1) - min) / Length) + 1
freq(j) = freq(j) + 1
End If
End If
Next i
Dim res() As Variant
ReDim res(M, 2)
For i = 1 To M
res(i, 1) = breaks(i)
res(i, 2) = freq(i)
Next i
Histogram = res
ErrHandler:
'Debug.Print Err.Description
End Function
Not 100% sure as to the efficacy of that approach but;
Remove the parens as your calling a sub; Hist M, arr
M is declared as double but received by the function as a long; this won't work so declare it in the calling routine as long
You will need to recieve arr() As Variant
Range -> Array produces a 2 dimensional array so the elements are arr(1, 1) .. arr(n, 1)