I need to use two Loops and the easy part is to count how many times does a "submodul" repeats in a defined and known range ("B3","B18"), this means the quantity of elements each submodul has. The difficult part comes when trying to count how many times does a "position" repeats for each different "submodul", this is because the amount of elements of each "submodul" is different so I have to adjust a range in a especial Loop to calculate how many times does a specific element (=Position) repeats within a "submodul".
The specific part that I need help with is the following:
positionrepetition = Application.CountIf(Worksheets("Sheet2").range("cells(3 + x + y - 1, 3)", "cells(3 + x + y - 1 + submodulrepetition,3"), position)
If I can manage to write it in a correct format I believe it will work. The problem is that normally I only use the range function when I know that the range is fixed or known, it doesn´t have to be calculated. I normally write for example: Range("A1","F10").Select
As you can see this is a fixed range, so I imagined that instead of using the format of Range("A1", "F10") I could use the range function with the arguments ("Cells(1,1)","Cells(10,6)"). Please correct me if I´m wrong.
Here is the rest of the code for the Loop.
For x = 0 To numberofparts
If Cells(3 + x, 18) = "1" Then
submodul = Cells(3 + x, 2).Value
submodulrepetition = Application.CountIf(Worksheets("Sheet2").range("B3", "B18"), submodul)
For y = 1 To submodulrepetition
position = Cells(3 + x + y - 1, 3).Value
positionrepetition = Application.CountIf(Worksheets("Sheet2").range("cells(3 + x + y - 1, 3)", "cells(3 + x + y - 1 + submodulrepetition,3"), position)
Next
Else
End If
x = x + submodulrepetition - 1
Next
To explain a little more, all data is gathered from Excel Sheets:
-All Information is gathered from a Excel sheet
-The "submodules" are in column B and they are arranged in numerical order. Every submodul repeats in this column as many elements it has.
-The "positions" (elements of the submodules) are in column C and can also repeat in the same column and even in other "Submodul"s.
All help will be appreciated and I thank you in advance.
Alejandro Farina
Change your line:
positionrepetition = Application.CountIf(Worksheets("Sheet2").Range("cells(3 + x + y - 1, 3)", "cells(3 + x + y - 1 + submodulrepetition,3"), Position)
With :
positionrepetition = Application.CountIf(Worksheets("Sheet2").Range(Cells(3 + x + y - 1, 3), Cells(3 + x + y - 1 + submodulrepetition, 3), Position))
If the Range is going to Change by Column/Row use the following code to get the end of column or row:
Dim GetColEnd, GetRowEnd As Integer
GetColEnd = Sheets("Sheet_Name").Cells(1, .Columns.Count).End(xlToLeft).Column
GetRowEnd = Sheets("Sheet_Name").Cells(Rows.Count, 1).End(xlUp).Row
Use the GetColEnd GetRowEnd in your Range function for flexible Column\Row for example as follows:
Sheets("Sheet_Name").Range(Cells(1,1),Cells(GetRowEnd,GetColEnd)
Related
Suppose in column Z with 200 rows, are my optimal averages.
Now I want a macro that generates n random integers between a and b inclusive (n <= 20) so that difference between the average of numbers generated with optimal average is in (-0.15,+0.15).
Example:
Z1:optimal average1=5.5
Z2:optimal average2=5.3
Z200:optimal average200=6.3
n=8
a=1; b=10
numbers of generated:
A1:H1)5-9-4-3-7-4-9-3
A2:H2)10-7-3-2-5-4-3-9
.
.
.
A200:H200)4-8-9-6-6-6-10-2
Here is a hit-or-miss approach (which is often the only viable way to get random numbers which satisfy additional constraints in an unbiased way):
Function RandIntVect(n As Long, a As Long, b As Long, mean As Double, tol As Double, Optional maxTries As Long = 1000) As Variant
'Uses a hit-or-miss approach to generate a vector of n random ints in a,b inclusive whose mean is
'within the tolerance tol of the given target mean
'The function raises an error if maxTries misses occur without a hit
Dim sum As Long, i As Long, j As Long
Dim lowTarget As Double, highTarget As Double 'targets for *sums*
Dim vect As Variant
lowTarget = n * (mean - tol)
highTarget = n * (mean + tol)
For i = 1 To maxTries
ReDim vect(1 To n)
sum = 0
j = 0
Do While j < n And sum + a * (n - j) <= highTarget And sum + b * (n - j) >= lowTarget
j = j + 1
vect(j) = Application.WorksheetFunction.RandBetween(a, b)
sum = sum + vect(j)
Loop
If j = n And lowTarget <= sum And sum <= highTarget Then
'Debug.Print i 'uncomment this line to see how many tries required
RandIntVect = vect
Exit Function
End If
Next i
'error if we get to here
RandIntVect = CVErr(xlErrValue)
End Function
This could be used as a worksheet array formula. The target means were in column I and in A2:H2 I entered =RandIntVect(8,1,10,I2,0.15) (with ctrl+shift+enter as an array formula) and then copied down:
Note that array formulas are volatile, so these numbers would be recalculated every time the worksheet is. You could use the function in VBA to place the numbers directly in the ranges rather than using the function as a worksheet formula. Something like:
Sub test()
Dim i As Long
For i = 1 To 3
Range(Cells(i + 1, 1), Cells(i + 1, 8)).Value = RandIntVect(8, 1, 10, Cells(i + 1, 9).Value, 0.15)
Next i
End Sub
enter image description here
The difference between two means is not within range (0.15+, 0.15-)
I need to take an input of mins and maxes for multiple variables and generate an array containing each possible combination.
Example: Entering the array
[A min, A max
B min, B max]
should return
[A min, B min
A min, B max
A max, B min
A max, B max]
I was able to do this but only with under 3 variables but can't conveniently expand it. I can't figure out how to make it work for any amount of variables, like if there was a C that also has a max and min.
Does anyone have suggestions?
edit:
If this helps anyone, purpose of this function is to find the extremes of a variable based expression. The first array is generated from the variables included in the expression, then the variables are replaced with values from the second array. So essentially every is calculated to find the highest possible outcome and lowest possible outcome.
So an input that created the first array could have been something like: 'A+B'
Then, for each row in the second array, 'A' and 'B' would be substituted with the instructed value.
Here is a VBA function which can be used to solve one interpretation of your problem:
Function Products(A As Variant) As Variant
'A is assumed to be a 2-column 1-based array
'The function returns another 2-column 1-based array
'Where each successive 4 rows gives the Cartesian product
'of two of the rows of A, with the earlier row
'providing the first element and the latter row the second
Dim i As Long, j As Long, k As Long, n As Long
Dim P As Variant
n = UBound(A, 1)
ReDim P(1 To 2 * n * (n - 1), 1 To 2)
k = 1
For i = 1 To n - 1
For j = i + 1 To n
P(k, 1) = A(i, 1)
P(k, 2) = A(j, 1)
P(k + 1, 1) = A(i, 1)
P(k + 1, 2) = A(j, 2)
P(k + 2, 1) = A(i, 2)
P(k + 2, 2) = A(j, 1)
P(k + 3, 1) = A(i, 2)
P(k + 3, 2) = A(j, 2)
k = k + 4
Next j
Next i
Products = P
End Function
Used like: Range("C1:D12").Value = Products(Range("A1:B3").Value)
I am working a code, and I have a problem with Excel's XIRR function.
You have a matrix with 2 columns (dates and amounts), so the inputs are the matrix, a date, and a quantity. Inside the code it takes the values below the date you used as input, makes a new array with those values, and add also the date and amount you entered as inputs. And the output should be the XIRR of that array. It doesn´t seem to work. It works with IRR, with dates are an important input. Does someone know how to fix this problem? Thanks in advance!
Function Retorno(matriz As Range, dia As Date, valuacion As Double) As Double
Dim Datos As Range
Dim Aux1()
Dim Aux2()
Dim i, j, m, n As Integer
Set Datos = matriz
j = 0
For i = 1 To Datos.Rows.Count
If Datos(i, 1) <= dia Then
j = j + 1
End If
Next i
ReDim Aux1(1 To j + 1)
ReDim Aux2(1 To j + 1)
For n = 1 To j + 1
Aux1(n) = Datos(n, 2)
Next n
Aux1(j + 1) = valuacion
For m = 1 To j + 1
Aux2(m) = Datos(m, 1)
Next m
Aux2(j + 1) = dia
Retorno = WorksheetFunction.Xirr(Aux1, Aux2)
End Function
Your last Aux2(j + 1) = dia is overwriting the second date in the array with the first date, giving you two identical dates in the date array.
Possibly you want to delete that line.
The other possible answer to this problem is to convert the date to numbers if you do this: Aux2(m) = Datos(m, 1)*1 XIRR will work too.
I am trying to create an automatic filling of the payroll spreadsheet I created. However, no matter how much I try it the value of z = 1 all the time even if the logic returns FALSE values (I validated this using MsgBox).
My goal in this code is to check whether there is already a record in another sheet. If there isn't it will automatically add the record with the appropriate details based on the available data.
Below is the full VBA code (Note code is incomplete so it is a bit unpolished still):
Option Explicit
Public p As Long
Sub test()
Dim Total_rows_PR As Long
Dim Total_rows_DTR As Long
Total_rows_PR = Worksheets("Payroll - Regular").Range("B" & Rows.Count).End(xlUp).Row
Total_rows_DTR = Worksheets("DTR").Range("B" & Rows.Count).End(xlUp).Row
Dim q As Long
Dim j As Long
Dim z As Long
For j = 1 To Total_rows_DTR - 1
For q = 1 To Total_rows_PR + p - 2
If Worksheets("DTR").Cells(1 + j, 33) = Worksheets("Payroll - Regular").Cells(2 + q, 1) Then
If Worksheets("DTR").Cells(1 + j, 34) = Worksheets("Payroll - Regular").Cells(2 + q, 2) Then
If Worksheets("DTR").Cells(1 + j, 2) = Worksheets("Payroll - Regular").Cells(2 + q, 3) Then
z = 1
Exit For
End If
End If
End If
Next q
' Below is where the assignment should happen but only returns a blank cell
If z = 0 Then Worksheets("Payroll - Regular").Cells(Total_rows_PR + 1 + p, 1) = Worksheets("DTR").Cells(1 + j, 33)
If z = 0 Then Worksheets("Payroll - Regular").Cells(Total_rows_PR + 1 + p, 2) = Worksheets("DTR").Cells(1 + j, 34)
If z = 0 Then Worksheets("Payroll - Regular").Cells(Total_rows_PR + 1 + p, 3) = Worksheets("DTR").Cells(1 + j, 2)
If z = 0 Then p = p + 1
z = 0
Next j
End Sub
Update: I realized that even if the conditions are not being a met in the first portion of If-Then loops, the value of z is set to 1 for no reason. This is the reason why it won't assign values. However, I do not see why it keeps assigning to 1.
Update#2: #ShaiRado
So the first image is where data is encoded (not shown in image because it is in the leftmost part of the spreadsheet, but basically it inputs the name of the person, date, and the daily time record (DTR) of the person). When the data is encoded, it will automatically indicate what month and year it is based on the helper column AG month and column AH for year. Somewhere in the start of the same worksheet at column B is where the name of the person is. All of these 3 will be used.
This second image is where the summaries are computed. If there is an entry for a specific person at a certain month and year and it is not located in this worksheet, it will automatically fill in that person's name as well as the month and year. Basically that's what the code i'm trying to create does.
The output is a fully automated spreadsheet that only requires data entry in the DTR sheet. All computations already have their corresponding formulas.
First: You have a really strange way of writing your if-statements.
I think what you mean is
For q = 1 To Total_rows_PR + p
If Worksheets("DTR").Cells(1 + j, 33) = Worksheets("Payroll - Regular").Cells(2 + q, 1) _
And Worksheets("DTR").Cells(1 + j, 34) = Worksheets("Payroll - Regular").Cells(2 + q, 2) _
And Worksheets("DTR").Cells(1 + j, 2) = Worksheets("Payroll - Regular").Cells(2 + q, 3) Then
z = 1
Exit For ' Once found, z stays 1 so you don't have to continue the inner loop.
End If
Next q
Second: I am not sure what exactly you want to achieve, but as far as I understand, your problem is that you are looping to far. At the last iteration of the outer loop, your accessing row 1 + j of sheet DTR which is empty at that time, and you are accessing row 2 + q (which is the same as 2 + Total_rows_PR + p) - also empty (and comparing the two emtpy lines sets z to 1).
A variable is never set for no reason. Is is maybe set and you don't understand the reason.
Debug your code step by step, watch where it behaves different as you expect and find the reason why it does what is does.
I was running tests on my software today and found that some of the values it was producing weren't correct.
I decided to step through the code and noticed that the variables I had assigned to textbox values on my userform when hovered over said empty, even though when hovering over the textbox assigned to it, the value inputted by the user showed.
For Example,
n = BiTimeSteps_TextBox.Value
when hovered over
n = empty
even though
BiTimeSteps_TextBox.Value = 2
when hovered over.
So say I have a formula shortly after that says
d = n*2 ,
n when hovered over says empty and d is made 0 when it shouldn't be.
Someone told me if I switch it around to
BiTimeSteps_TextBox.Value = n
it should be recognised but it is still not.
What could possibly be causing this?
See full code below: (it aims to price options using the binomial tree pricing method)
S = BiCurrentStockPrice_TextBox.Value
X = BiStrikePrice_TextBox.Value
r = BiRisk_Free_Rate_TextBox.Value
T = BiexpTime_TextBox.Value
Sigma = BiVolatility_TextBox.Value
n = BiTimeSteps_TextBox.Value
Dim i, j, k As Integer
Dim p, V, u, d, dt As Double
dt = T / n ' This finds the value of dt
u = Exp(Sigma * Sqr(dt)) 'formula for the up factor
d = 1 - u 'formula for the down factor
'V value of option
'array having the values
Dim bin() As Double 'is a binomial arrays, it stores the value of each node, there is a loop
'work out the risk free probability
p = (1 + r - d) / (u - d)
'probability of going up
ReDim bin(n + 1) As Double
'it redims the array, and n+1 is used because it starts from zero
'------------------------------------------------------------------------------------------------------------------------------
''European Call
If BiCall_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, (u ^ (n - i)) * (d ^ i) * S - X)
'It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
'european put
If BiPut_CheckBox = True Then
For i = 0 To n 'payoffs = value of option at final time
bin(i + 1) = Application.WorksheetFunction.Max(0, X - (S * (u * (n - i)) * (d * i)))
' European Put- It takes the max payoff or 0
Cells(i + 20, n + 2) = bin(i + 1) 'to view payoffs on the isolated column on the right
Next i
End If
For k = 1 To n 'backward column loop
For j = 1 To (n - k + 1) 'loop down the column loop
bin(j) = (p * bin(j) + (1 - p) * bin(j + 1)) / (1 + r)
Cells(j + 19, n - k + 2) = bin(j)
'' print the values along the column, view of tree
Next j
Next k
Worksheets("Binomial").Cells(17, 2) = bin(1) ' print of the value V
BiOptionPrice_TextBox = bin(1)