Here I Have some complex combination problem for VBA in Excel.
I have n variable defined by starting value, stop value and steps.
N variables are double values basically like below.
Var1, Var2, Var3, .... VarN
start: 20, 1, 0.1, ....
stop : 100, 10, 1.0, ....
step : 10, 1, 0.1, ....
What is the most efficient (fast) way of generating combination of each variable like below:
20, 1, 0.1
20, 1, 0.2
20, 1, 0.3
...
...
...
100, 10, 0.8
100, 10, 0.9
100, 10, 1.0
I believe that there are all 900 combinations (=9x10x10) for this case.
More challenging part is that I need more flexible solution for N variable cases using double array like this (without involving any worksheet formula):
Private startValue() As Double ' start value of each variable
Private stopValue() As Double ' stop value of each variable
Private stepValue() As Double ' step value of each variable
Private combination() as double 'combination of all N variable
Private n as integer ' number of variable = N
ReDim startValue(1 To 1, 1 To n) As Double
ReDim stopValue(1 To 1, 1 To n) As Double
ReDim stepValue(1 To 1, 1 To n) As Double
I really appreciated for your kind help.
Kind regards.
Why you require 2 dimensional array if you want 3 arrays for startValue, stopValue and stepValue. Alternately, You can use only one 2-dimensional array
ReDim arrValue(0 To 2, 0 To n-1) As Double
where index 0 = Start, 1 = Stop, 2 = Step
Rather than creating an array and then assigning values to it, you can let Excel do the job by assigning a range to your variable (i.e. arrMyValues = Range("A2:C4")). But as in your case we don't know the last column, we first have to get the last column. We can get this by:
oWS.Cells(1, Columns.Count).End(xlToLeft).Column
This will return the number of columns used in your sheet. In this instance however, we need the name of the last column. To get that we first get the last column addres:
oWS.Cells(1, Columns.Count).End(xlToLeft).Address
We then split this address into an array so that we can get the column name:
arrColAddress = Split(oWS.Cells(1, Columns.Count).End(xlToLeft).Address, "$")
Now that we have the name of the last column, we can use the name with row count to pass the range into our variable. To get the row count for the sheet, we can use:
oWS.Cells(Rows.Count, "B").End(xlUp).Row
If we put all of this together (only thing I added was a worksheet object), we get:
Dim oWS as Worksheet : Set oWS = Worksheets("your worksheet name")
arrColAddress = Split(oWS.Cells(1, Columns.Count).End(xlToLeft).Address, "$")
arrMyValues = oWS.Range("A2:" & arrColAddress(1) & oWS.Cells(Rows.Count, "B").End(xlUp).Row)
Code is based on the table you provided
Here is a solution which should work for any number of variables:
'The following takes a 1-based variant area with 3 rows
'And n columns, where n is the number of variables
'The first row are start values, the second is stop, and the
'third is step-size.
'It returns a variant array consisting of all combos
Function MakeCombos(Vals As Variant) As Variant
Dim i As Long, j As Long, n As Long
Dim numCombos As Long
Dim combos As Variant, levels As Variant
Dim var As Double, varStep As Double, colStep As Long
If TypeName(Vals) = "Range" Then Vals = Vals.Value 'make into a VBA array if passed a range
n = UBound(Vals, 2)
ReDim levels(1 To n)
'first find the *number* of levels for each variable
numCombos = 1
For i = 1 To n
levels(i) = 1 + Round((Vals(2, i) - Vals(1, i)) / Vals(3, i))
numCombos = numCombos * levels(i)
Next i
ReDim combos(1 To numCombos, 1 To n)
'Now -- just fill in column by column in reverse order with some modular arithmetic
colStep = 1 'how often value is changed in column
For j = n To 1 Step -1
var = Vals(1, j)
varStep = Vals(3, j)
combos(1, j) = var
For i = 1 To numCombos - 1
combos(i + 1, j) = var + (Int(i / colStep) Mod levels(j)) * varStep
Next i
'before next pass theough outer loop, increase colStep so that
'in the next column will step more slowly
colStep = colStep * levels(j)
Next j
MakeCombos = combos
End Function
To test it, I started with a spreadsheet that looks like:
Then ran this code:
Sub test()
Range("F1:H900").Value = MakeCombos(Range("B2:D4"))
End Sub
After which the data in columns F:H starts with:
and 900 rows down ends with:
Related
I am having trouble getting Variants to subtract. I am pulling data from a spreadsheet and if one cell states a phrase then I need the code to subtract one cell from another. If the cell does not state a phrase then I need it to copy one cell to another. I can get the code to run but nothing happens.
Private Sub CommandButton1_Click()
Dim x As Variant, y As Variant, z As Variant, a As Integer, B As String
'getting values for data
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
B = "Total ISU Days: "
'The the cells are empty then subtract. This is not what I wanted to do but I can't think of extracting strings from variants.
If IsEmpty(Range("D2:D48").Value) = True Then
a = y - z
End If
Range("N2:N48").Value = a
Range("M2:M48").Value = B
End Sub
x = Range("D2:D48").Value
y = Range("I2:I48").Value
z = Range("E2:E48").Value
A Variant contains metadata about its subtype. In this case, x, y, and z are all arrays of variants.
a = y - z
The right-hand side of this expression simply cannot be evaluated, because {array1} - {array2} means nothing: operators (arithmetic or logical) work off values, not array of values.
What is a supposed to be? It's declared As Integer, so its value is capped at 32,767 (should probably be a Long). If you mean to add up all the values in y and subtract that total from the sum of all values in z, then you need to be more explicit about how you do that - you could use Application[.WorksheetFunction].Sum to add things up:
sumOfY = Application.Sum(Range("I2:I48"))
sumOfZ = Application.Sum(Range("E2:E48"))
a = sumOfY - sumOfZ
And then...
Range("N2:N48").Value = a
That will put the value of a in every single cell in the N2:N48 range - is that really what you mean to do?
Or maybe you meant to do this instead?
Range("N2:N48").Formula = "=IF(D2="""",I2-E2,0)"
That would make each cell in N2:N48 calculate the difference between I and E for each row where D is empty... and there's not really any need for any VBA code to do this.
Let's simplify a bit the task and say that the idea is to substract the values in Range("C1:C6") from the corresponding values in the left - Range("B1:B6"). Then write the corresponding results in column E:
Of course, this would be done only in case that all values in column A are empty. This is one way to do it:
Sub TestMe()
Dim checkNotEmpty As Boolean: checkNotEmpty = False
Dim substractFrom As Range: Set substractFrom = Worksheets(1).Range("B1:B6")
Dim substractTo As Range: Set substractTo = Worksheets(1).Range("C1:C6")
Dim MyCell As Range
Dim result() As Variant
ReDim result(substractFrom.Cells.Count - 1)
Dim areCellsEmpty As Boolean
For Each MyCell In substractFrom
If Len(MyCell) > 0 Then checkNotEmpty = True
Next
Dim i As Long
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result)
End Sub
The code could be improved further, saving all ranges to an Array, but it works quite ok so far.
The part with the +1 and -1 in the For-loop is needed as a workaround:
For i = LBound(result) + 1 To UBound(result) + 1
result(i - 1) = substractFrom.Cells(i) - substractTo.Cells(i)
Next
because the arrays start from index 0, but the Cells in a range start with row 1.
Worksheets(1).Range("E1").Resize(UBound(result) + 1) = Application.Transpose(result) is needed, to write the values of the result array to the column E, without defining the length of the range in E.
Does anyone know a routine on how to get a data set composed by 7 columns into all possible combinations?
the combination is composed by 7 numbers like this--> 1|3|8|10|35|40|50
The routine needs to look into the first table and make a list of all possible combination excluding the duplicate numbers from the combination in the second table. Please see picture.
The table on the left contains the combination which need to be reshuffled, into the right table which contain all possible combinations.
I would do something like:
The number of options are 6^7 so there will be alot of cases: 279936
To get all of it, you should loop through them.
First we should find all the options.
To generate all the possible combinations including duplicates, the probles is the same as get all the may 7 digit long numbers in base 6 ( as we have 6 number in each column)
in newer excels you can use the BASE funtion, but if you can not access it you can use this:
if you cange a code a bit you can call the value of the original table instead of the 0-5 numbers.
Then just remove duplicates.
Sub generateAllBase6()
Dim i As Double 'number tries
Dim n As String ' the number of item from the column 1-7
For i = 0 To 279936 - 1
n = ConvertBase10(i, "012345")
For k = 1 To 7
If Len(n) < k Then
Cells(i + 2, k) = 0
Else
Cells(i + 2, k) = Right(Left(n, k), 1)
End If
Next k
Next i
End Sub
Public Function ConvertBase10(ByVal d As Double, ByVal sNewBaseDigits As String) As String
Dim S As String, tmp As Double, i As Integer, lastI As Integer
Dim BaseSize As Integer
BaseSize = Len(sNewBaseDigits)
Do While Val(d) <> 0
tmp = d
i = 0
Do While tmp >= BaseSize
i = i + 1
tmp = tmp / BaseSize
Loop
If i <> lastI - 1 And lastI <> 0 Then S = S & String(lastI - i - 1, Left(sNewBaseDigits, 1)) 'get the zero digits inside the number
tmp = Int(tmp) 'truncate decimals
S = S + Mid(sNewBaseDigits, tmp + 1, 1)
d = d - tmp * (BaseSize ^ i)
lastI = i
Loop
S = S & String(i, Left(sNewBaseDigits, 1)) 'get the zero digits at the end of the number
ConvertBase10 = S
End Function
I found the funcion here: http://www.freevbcode.com/ShowCode.asp?ID=6604
In this VBA program all I am trying to do is to pass an array from spreadsheet and add 1 to each of the array's cells. My problem is with the index of the array. when I start looping the array it doesnt
work when I start the index from zero ( I get error subscript out of range) but it works perfectly when I start the array from 1. Why is that? (I thought that would be the case only I specify at the top Option Base 1)
Sub Passarray()
Dim Array As Variant
Dim i, j As Integer
'Pass array and manipulate
Vol = Range("Volatility")
For i = 0 To 2
For j = 0 To 2
Vol(i, j) = 1+ Vol(i,j)
Next j
Next i
End Sub
That wasn't the case when you pass Range to arrays based on my experience.
I don't know the specific reason behind, but this link indicates that you cannot change this behavior.
QUOTE: The array into which the worksheet data is loaded always has an lower bound (LBound) equal to 1, regardless of what Option Base directive you may have in your module. You cannot change this behavior.
What you can do is to utilize the use of LBound/UBound like this:
Vol = Range("Volatility")
For i = LBound(Vol, 1) To UBound(Vol, 1)
For j = Lbound(Vol, 2) To Ubound(Vol, 2)
'~~> do stuff here
Vol(i, j) = 1 + Vol(i, j)
Next j
Next i
If however your Range is just one column with several rows, you pass it to Array like this:
Vol = Application.Transpose(Range("Volatility"))
For i = LBound(Vol) To UBound(Vol)
'~~> do stuff here
Vol(i) = 1 + Vol(i)
Next
This way, you will produce one-D array instead of two-D array.
To iterate values you can use above or you can also use For Each:
Dim x As Variant '~~> dimension another variant variable
For Each x In Vol
'~~> do stuff here
x = 1 + x
Next
Why doesn't this function work?
Type =funtest(2.1) in Excel and it'll give me #VALUE!.
Public Function funtest(a As Double) As Double
Dim z, j, i As Integer
Dim matrix(3, 3, 3) As Double
For z = 0 To 3 Step 1
For j = 0 To 3 Step 1
For i = 0 To 3 Step 1
matrix(z, j, i) = a
Next i, j, z
funtest = Application.WorksheetFunction.Sum(matrix)
End Function
WorksheetFunction.Sum will work with either a range or a 2 dimentional array. It errors because you are passing it a 3 dimensional array.
So, this works
Public Function funtest(a As Double) As Double
Dim z As Long, j As Long, i As Long
Dim matrix() As Double
ReDim matrix(0 To 3, 0 To 4)
For j = LBound(matrix, 1) To UBound(matrix, 1)
For i = LBound(matrix, 2) To UBound(matrix, 2)
matrix(j, i) = a
Next i, j
funtest = Application.WorksheetFunction.Sum(matrix)
End Function
Note I have modified your declarations slighly, see note at end of answer.
To sum higher dimensional arrays you will need to do some looping.
One option (which may or may not suit your overal requirements) is to declare your array slightly differently, as a so called Jagged Array.
Public Function funtest2(a As Double) As Double
Dim z As Long, j As Long, i As Long
Dim matrix() As Variant
Dim InnerMatrix(0 To 4, 0 To 4) As Double
' Dimension Jagged Array
ReDim matrix(0 To 4)
For i = LBound(matrix, 1) To UBound(matrix, 1)
matrix(i) = InnerMatrix
Next
'Load Data into matrix
For z = LBound(matrix) To UBound(matrix)
For j = LBound(matrix(z), 1) To UBound(matrix(z), 1)
For i = LBound(matrix(z), 2) To UBound(matrix(z), 2)
matrix(z)(j, i) = a
Next i, j, z
' Sum matrix
For z = LBound(matrix) To UBound(matrix)
funtest2 = funtest2 + Application.WorksheetFunction.Sum(matrix(z))
Next
End Function
This is an array of 2 dimensional arrays. The Sum is then applied to each of the inner arrays in turn. This way, at least you are only looping one dimension and not all three.
Note on Dim and Integer
You must specify all As Type's, otherwise variables default to Variant
In your code z and j will be Variants
Also, using Integer rather than Long is actually counter productive on a 32 bit OS: Long's will be slightly faster.
I'm going to take you literally when you say "I'm trying to solve the simple case of a (3,3,3) matrix with each element equal to some double, a". This will do that:
Public Function funtest(a As Double) As Double
funtest = 4*4*4*a
End Function
First, when you get #VALUE! this means there is an error, it can mean using a matrix that is not valid.
To answer your question, your code does not work because your syntax is not correct. The following function creates a matrix from values.
Function FQ_matrix_create(StartValue As Double, Interval As Double,
nrow As Long, ncol As Long) As Double()
Dim M() As Double
' Creates matrix with sequential element values with given row and
' column sizes. Fills matrix row-wise with numbers.
' - set Interval = 0 for constant element values
' - error input arguments nrow and ncol are not positive integers
To SUM the Values use:
Function FQ_matrix_element_sum(M() As Double, SumOption As
MatrixDirection) As Double()
' Returns the sum of elements of matrix M, either row or column wise
' - Rowwise sum returns a horizontal 1xNcol matrix
' - Columnwise sum returns a vertical 1 xNrow matrix
' - Element sum (all elements) returns a 1x1 matrix
' - error if M is not a matrix
' - error if SumOption is not 1 (nRowWiseSum) or 2 (nColWiseSum) or
3 (nElementSum)
To help you understand Matrix in Excel VBA, here is a good resource: http://finaquant.com/download/matrixvectorvba
Specifically, take a look at the PDF Download on the site.
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)