I want to simulate a binomial distribution where the price of something can only go up or down with the probability of p that is 50% this time.
My variables:
S=100 (the basic value)
u=1,1 (how much the value goes up in each experiment if it goes up)
d=1/u (how much the value goes down in each experiment if it goes down)
p=0.5 (probability)
n=400 (number of experiments)
I did not declare these variables, because I want to read these values from specific cells.
My code (for the first step):
Sub BINOM()
S = Range("L4").Value
u = Range("M4").Value
d = Range("N4").Value
p = Range("O4").Value
n = Range("P4").Value
v = Rnd()
If v > p Then
Range("B2").Value = S * u
Else
Range("B2").Value = S * d
End If
End Sub
The result of the second experiment (that should be written in the B3 cell) has to be calculated from the result of the first experiment and so on but not with using the same random number.
I'll try my best but I just removed Excel in favor of Calc which doesn't support the same type of language as far as I can tell.
Sub BINOM()
Dim intCounter, v
S = Range("L4").Value
u = Range("M4").Value
d = Range("N4").Value
p = Range("O4").Value
n = Range("P4").Value
Range("B1").Value = s
For intCounter = 2 to n
'//If this creates an error then just remove it.
'//It should keep the same random number from appearing over and over.
Randomize
'//Create new Random number in v
v = Rnd()
If v > p Then
Range("B" & intCounter).Value = Range("B" & (intCounter - 1)).Value * u
Else
Range("B" & intCounter).Value = Range("B" & (intCounter - 1)).Value * d
End If
Next intCounter
End Sub
Let me know if that works out for you or if any errors appear. Updated to base each cell from data given of previous cell.
Related
I want to automate a calculation for a measurement data Excel file.
While I made the function work, I could only figure out how to do that for one row at a time. The calculation is specific to the data on every row.
I thought I could change the Range("J3") value to Range("J3:J52") for a capacity of 50 calculations.
How do I make the function calculate for every row, separately, using the data of said specific row?
It doesn't matter if it runs for all 50 rows or if I have to figure out some loop function to find how many rows to calculate for, as long as one button press in the end will make the magic happen.
I have included a screenshot of the sheet for reference, the main calculation is done in Excel, but what this is doing is choosing the correct option out of a few different correction calculations and explaining to the user why.
I think there are some unnecessary Dim lines at the start but if it runs, I wasn't going to remove them.
'The main function, activated by a simple button Sub'
Function ISO16032()
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F3")
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F3").Value
Select Case Range("F3").Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J3")
Range("G3").Value = Result
Note = "No correction"
Range("H3").Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K3")
Range("G3").Value = Result
Note = "Correction per ISO16032"
Range("H3").Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L3")
Range("G3").Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H3").Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H3").Value = Note
End Select
End Function
Hi and welcome to stackoverflow, I think that a simple loop, with the addition of an argument to your ISO function allows you to solve your problem like this
Sub Looping()
For i = 3 To 52
' Convert i to String because we need to concatenate with the letter F, G, H...
Call ISO16032(CStr(i))
Next
End Sub
Function ISO16032(Cell_X)
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F" + Cell_X)
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F" + Cell_X).Value
Select Case Range("F" + Cell_X).Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "No correction"
Range("H" + Cell_X).Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction per ISO16032"
Range("H" + Cell_X).Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H" + Cell_X).Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H" + Cell_X).Value = Note
End Select
End Function
EDIT: think indented your code like I did to make it more readable too (or like #Darren Bartrup-Cook did when editing your question)
This is more of an example of how to calculate each row.
Just getting your code to work across multiple rows.
Cells
With...End With Statement
'No need for Sub to call function that doesn't return anything.... just write a sub.
Public Sub ISO16032()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 10).End(xlUp).Row
Dim RowCounter As Long
Dim Result As Long
Dim Note As String
'Only calculate if there is data in rows 3 onwards.
If LastRow >= 3 Then
'Reset results on each pass.
'Assuming -1 is an impossible answer so code knows
'not to put anything on Case Else.
Result = -1
Note = ""
'Cycle through each row and calculate.
For RowCounter = 3 To LastRow
Select Case .Cells(RowCounter, 6) 'Look at column F(column 6) on each row.
Case 10.6 To 200
Result = .Cells(RowCounter, 10)
Note = "No corrections."
Case 3.6 To 10.5
Result = .Cells(RowCounter, 11)
Note = "Correction per ISO16032"
Case 0.1 To 3.5
Result = .Cells(RowCounter, 12)
Note = "Correction limit set to 2,2 dB"
Case Else
Note = "Repeat measurement!"
End Select
'Place results on sheet.
.Cells(RowCounter, 7) = IIf(Result >= 0, Result, "")
.Cells(RowCounter, 8) = Note
Next RowCounter
End If
End With
End Sub
I have defined, inside an Excel workbook, a function that calculates a physical property taking as an input a Temperature and a Pressure.
It operates interpolating discrete data from a T/P matrix on a dedicated spreadsheet. The matrix can be modified as needed.
In case one of the given input data falls outside the data matrix range, the function is forced to calculate using the boundary. For example: If discrete Temperatures data in the matrix are from 40°C to 90°C, in the case that a temperature below 40°C is given to the function as input it will proceed to calculate using 40°C.
What I would like to do is to give a warning inside the cell containing the function call. In order to warn the user that the result is extrapolated and may not be accurate. Something similar to the warnings that excel gives to you, inside the cells, when a number is formatted as text or a formula inside a cell is different from the formulas in cells of the same column or row.
Is it possible to do it?
For sake of clarity, I add the code I wrote:
Function Z(T As Double, P As Double)
Dim i As Integer, j As Integer, r As Integer, c As Integer
Dim T1 As Double, T2 As Double, P1 As Double, P2 As Double, Z1 As Double, Z2 As Double
Dim ckp As Boolean, ckt As Boolean
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Z")
i = 2
j = 2
ckp = False
cht = False
'check if T < T min; if yes, set T = T min
If T < wks.Cells(1, 2) Then
i = 3
T = wks.Cells(1, 2).Value
ckt = True
End If
'check if P < P min; if yes, set P = P min
If P < wks.Cells(2, 1) Then
j = 3
P = wks.Cells(2, 1).Value
ckp = True
End If
'if temperature is not below the minimum, find the column containing the T_
immediately above the given one.
If ckt = False Then
Do
i = i + 1
'Check if T is > T max; if a blank cell is found during seeking, T_
is set at maximum.
If wks.Cells(1, i) = "" Then
T = wks.Cells(1, i - 1)
i = i - 1
ckt = True
End If
Loop While wks.Cells(1, i) < T And ckt = False
End If
'if pressure is not below the minimum, find the row containing the P_
immediately above the given one.
If ckp = False Then
Do
j = j + 1
'Check if P is > P max; if a blank cell is found during seeking, P_
is set at maximum.
If wks.Cells(j, 1) = "" Then
P = wks.Cells(j - 1, 1)
j = j - 1
ckp = True
End If
Loop While wks.Cells(j, 1) < P And ckp = False
End If
'Calculate the function by sequentially using Line Passing Through Two_
Points (RDP)user defined function.
'T1 is the temperature immediately below the given one and T2 is the_
temperature immediately above the given one
'T will be between T1 and T2
'P1 is the pressure immediately below the given one and P2 is the pressure_
immediately above the given one
'P will be between P1 and P2
T1 = wks.Cells(1, i - 1)
T2 = wks.Cells(1, i)
P1 = wks.Cells(j - 1, 1)
P2 = wks.Cells(j, 1)
'Calculate function at T1 and P
Z1 = RDP(P1, P2, wks.Cells(j - 1, i - 1), wks.Cells(j, i - 1), P)
'Calculate function at T2 and P
Z2 = RDP(P1, P2, wks.Cells(j - 1, i), wks.Cells(j, i), P)
'Calculate function at T and P
Z = RDP(T1, T2, Z1, Z2, T)
End Function
I also add a snapshot of the "Z" spreadsheet. Data are calculated by means of a process simulation software. In this way I can use the same spreadsheet in calculations where T and P vary between different ranges and steps, being the function still able to operate. All I need is the function to tell me: "I gave you a result but consider that you gave me an out of range parameter, so pay attention", without stopping processing data (it is used in hundreds of cells, together with other similar functions calculating other parameters)
In the "Z" spreadsheet snapshot, T are in the first row and P in the first column. In "J2" cell you can see the result inputing a Temperature of 100°C and a pressure of 42.5 bar (average between 40 and 45). The result is an average between the Z "90°C and 40 bar" and the Z "90°C and 45 bar".
I hope the issue to be more clear, now.
I found a solution to the posted problem and I share it, hoping that it could be useful. Even if it does not involve warning messages, the user is warned that something is not optimal and the given result could be not accurate. I proceeded in this way:
1) I modified the function to give a variant (1,2) array as a result. The first data is the actual function output, while the second one is a boolean value which can be "TRUE" if the calculation has been forced (not accurate) or "FALSE" otherwise.
2) I asked excel to evaluate "INDEX(Z(cellA,cellB),2)" to conditionally format the cell where the function is used, using the same arguments of the function inside the cell.
In this way, every time the function has been forced to give an output the cell results to be formatted in a different way (for example, with bold and red character).
Here below the modified Function:
Function Z(T As Double, P As Double)
Dim i As Integer, j As Integer, r As Integer, c As Integer
Dim T1 As Double, T2 As Double, P1 As Double, P2 As Double, Z1 As Double, _
Z2 As Double
Dim ckp As Boolean, ckt As Boolean
Dim wks As Worksheet
Dim returnval(2)
Set wks = ThisWorkbook.Sheets("Z")
i = 2
j = 2
ckp = False
ckt = False
'check if T < T min; if yes, set T = T min
If T < wks.Cells(1, 2) Then
i = 3
T = wks.Cells(1, 2).Value
ckt = True
End If
'check if P < P min; if yes, set P = P min
If P < wks.Cells(2, 1) Then
j = 3
P = wks.Cells(2, 1).Value
ckp = True
End If
'if temperature is not below the minimum, find the column containing the T_
immediately above the given one.
If ckt = False Then
Do
i = i + 1
'Check if T is > T max; if a blank cell is found during seeking, T _
is set at maximum.
If wks.Cells(1, i) = "" Then
T = wks.Cells(1, i - 1)
i = i - 1
ckt = True
End If
Loop While wks.Cells(1, i) < T And ckt = False
End If
'if pressure is not below the minimum, find the row containing the P_
immediately above the given one.
If ckp = False Then
Do
j = j + 1
'Check if P is > P max; if a blank cell is found during seeking, P_
is set at maximum.
If wks.Cells(j, 1) = "" Then
P = wks.Cells(j - 1, 1)
j = j - 1
ckp = True
End If
Loop While wks.Cells(j, 1) < P And ckp = False
End If
'Calculate the function by sequentially using Line Passing Through Two_
Points (RDP)user defined function.
'T1 is the temperature immediately below the given one and T2 is the_
temperature immediately above the given one
'T will be between T1 and T2
'P1 is the pressure immediately below the given one and P2 is the_
pressure immediately above the given one
'P will be between P1 and P2
T1 = wks.Cells(1, i - 1)
T2 = wks.Cells(1, i)
P1 = wks.Cells(j - 1, 1)
P2 = wks.Cells(j, 1)
'Calculate function at T1 and P
Z1 = RDP(P1, P2, wks.Cells(j - 1, i - 1), wks.Cells(j, i - 1), P)
'Calculate function at T2 and P
Z2 = RDP(P1, P2, wks.Cells(j - 1, i), wks.Cells(j, i), P)
'Calculate function at T and P
returnval(0) = RDP(T1, T2, Z1, Z2, T)
If ckt = True Or ckp = True Then
returnval(1) = True
Else
returnval(1) = False
End If
Z = returnval
End Function
I have a code that searches an excel fill for the word distance, takes the value of the cell next to it, paste it into a new cell, then sums all the cells up. Which works great, but i now need to find a way to only sum ever even row number. Does that make sense?
Sub Distance_Check()
Dim DistanceCheck As String
Dim DistanceNumber As String
Dim DistanceSum As String
Dim DistanceTotal As String
DistanceCheck = MsgBox("Would you like to check the distance?", vbYesNo)
If DistanceCheck = vbYes Then
If IsArray(fname) Then Workbooks.OpenText fname(1)
i = 1
findStr = "Distance"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("J" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
Set wkbSourceBook = ActiveWorkbook
DistanceNumber = i - 2
DistanceSum = WorksheetFunction.Sum(Range(Cells(2, 15), (Cells(DistanceNumber + 1, 15))))
DistanceTotal = DistanceSum / DistanceNumber
If DistanceNumber = Cells(2, 12) Then
MsgBox ("No error found wihin distance")
Else
MsgBox ("Error found with distance")
End If
Else
End If
Call Save_Data
End Sub
Would the way youd go about this be using a for loop on the
cells(DistanceNumber(j,+1)
Where j = 0,
j = j +2 ,
Until j > DistanceNumber,
Would that work? If so how would you go about it?
Thanks
A quick way to step through a loop in the desired increments is to use the Mod operator which divides two numbers and returns any remainder (e.g. 7 mod 2 = 1, as two sixes fit into seven, leaving one).
You can use the row property of the range you identify with the Find method, and since you want to jump by two the modulo should be zero:
If foundcel.Row Mod 2 = 0 Then Range("J" & i).value = foundcel.Offset(0, 1).Value
That said, there is a 'built in' way to step through a loop if using a For loop like this
For x = 2 to 10 Step 2
' Do stuff
Next x
You can also use this method to step backwards, e.g.
For x = 100 to 0 Step -10
' Do stuff backwards!
Next x
I am trying to use step functions to describe a curve. This is mainly due to other methods not being as precise as this one, in which the data points are connected by a linear relationship.
I have a table of x-values. Each x-value is taken, and compared to a second table until the following condition is met:
Value2>Value1
Once that is achieved, the second table is used to construct a linear relationship, with which I can accurately calculate the first values actual result, the y-value (assuming y = f(x) ), which is introduced to a last table.
This process has to be repeated then exactly the same way, however the table from which the first value is taken and the table from below which contains the results shifts to the right for every table iteration.
The code I used is as follows:
Sub alpha()
Dim a As Integer
a = 0
Begin_Count:
a = a + 1
Dim l As Integer
For l = 1 To 13
'Check the first value
Val1 = Range(Chr(a + 66) & (l + 269))
'Check the numbers to compare range
Dim i As Integer
For i = 1 To 12:
Val2 = Range(Chr(67) & (i + 284))
If Val2 > Val1 = True Then
'Calculate Cl
dy = (Range("D" & (i + 284)) - Range("D" & (i + 283)))
dx = (Range("C" & (i + 284)) - Range("C" & (i + 283)))
x = (Val1 - Range("C" & (i + 283)))
y = Range("D" & (i + 283))
Cl = ((dy / dx) * x) + y
'Insert Cl
Range(Chr(a + 66) & (l + 299)).Value = Cl
Exit For
End If
Next
Next
If a < 101 = True Then
GoTo Begin_Count
End If
End Sub
This code runs until it reaches the point in which the cells from Excel are labeled "AA","AB",etc., at which the code gives an error.
Can anyone help me out with this?
Instead of:
Range(Chr(a + 66) & (l + 299)).Value = Cl
use
Cells(l+299, a).Value = Cl
In general it's easier to use Cells() with two numeric arguments than to try to create an address string to pass to Range(), particularly if you're working on a single cell.
Just a couple quick things...
Always use Option Explicit in your code modules. It forces you to declare your variables and helps avoid crossing up value types.
Always create a worksheet object, so you can "guarantee" which worksheet your code refers. It makes it more clear, especially when you're involving multiple worksheets (maybe not now, but later).
Finally, refer to the values in your table using the Cells(rowindex,columnindex) format. This way you can index rows and columns numerically.
Option Explicit
sub alpha()
Dim ws as Worksheet
Dim a as Integer
Dim lrow as Integer, lcol as Integer
Dim irow as Integer, icol as Integer
Dim
Set ws = Activesheet
a = 0
Val1 = ws.Cells(lrow, lcol).value
end sub
We have prefix defined already (say ABC, GIJ, THK, JLK ...so on) and want to create a sequential number when a user wants to generate a number for each of these prefix like given below:
ABC0000 , ABC0001 , ABC0002 ...ABC9999 same for GIJ0000 , GIJ0001 , GIJ0002 ...GIJ9999.
Given below is the code written for the above logic, but it does not achieve the requirement:
Private Sub CommandButton1_Click()
With ComboBox1.Value
Dim a, b As String
Dim i, j, k, l, x, q, m, temp As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a, Range("A1:A1000"), 0)
j = Cells(i, 2)
l = j * 1000
For q = 2 To 100
For m = 2 To 100
If Cells(q, m).Value < 0 Then
k = m
End If
Next
Next
x = l
If Cells(i, GC).Value = temp Then
click = click + 1
Else
click = 0
End If*
Cells(i, GC) = x + click
TextBox1.Text = x + click
temp = Cells(i, GC).Value
End With
GC = GC + 1
End Sub
VBA does not seem necessary for this. Assuming you have your prefixes in separate cells in ColumnA starting in Row1, put in B1:
=A1&TEXT(COUNTIF(A$1:A1,A1)-1,"0000")
and double-click its fill handle.
From your code, I assume that you have a ComboBox named ComboBox1, a CommandButton named CommandButton1 and a TextBox named TextBox1, all on a UserForm, and with ComboBox1 filled with the possible values for prefixes.
The following code will put the next available code(1) for the selected prefix into the TextBox.
Private Sub CommandButton1_Click()
Dim a As String
Dim i As Long, j As Long
a = ComboBox1.Text
i = Application.WorksheetFunction.Match(a & "9999", Range("A1:A1000"), 1)
j = CLng(Mid$(Cells(i, 1).Value, Len(a) + 1)) + 1
TextBox1.Text = a & Format(j, "0000")
End Sub
Your code is also doing a lot of unnecessary stuff.
(1) only if data is sorted.