I'm trying to code a line in VBA that would allow me to generate random numbers between -35 and 5. I've used the below formula however, it gives me random numbers between -5 and +5
Int((Rnd() * ((-1) ^ Int(Rnd() * 10))) * 5)
Fix(Rnd() * 41) - 35
will do it. This will be uniformly distributed insofar that Rnd() is. Fix scrubs the decimal portion of a number. You want every number between -35 and 5 inclusive which is 41 numbers. rnd() itself never draws 1.
Test the generator with something like
Sub test()
Dim j As Long
While True
j = Fix(Rnd() * 41) - 35
VBA.DoEvents 'so you can break the program once you're done
If j < -35 Or j > 5 Then
Stop 'oops
End If
If j = -35 Then
Debug.Print "Yup, I draw on the boundary"
End If
If j = 5 Then
Debug.Print "Yup, I draw on the boundary"
End If
Wend
End Sub
If you want an uniform distribution:
Int(Rnd*41)-35
0<=Rnd<1 (some time back I found Rnd=1, but it seams not happening any more)
0<=Rnd*41<41
0<=Int(Rnd*41)<=40
-35<=Int(Rnd*41)-35<=5
From documentation:
Int
Returns the integer portion of a number.
Related
I was trying to do the following using Excel VBA:
[1] 30 numbers (Input manually in Excel)
[2] Pick 1 number from [1] and x 1.5
[3] Pick another 5 numbers from [1]
[4] Sum all values from [2] and [3]
[5] Define a min and max range for the sum
[6] Print out all the sum from [4] that meet range [5]
I was creating an array of the 30 numbers, create a loop of each element, eliminate that element in the array so it would not double count and sum it up. However, I'm not sure what is the logic of this should be to incorporate the value from [2].
I suggest a slightly different process:
Create your array of 30 numbers
Randomly select 6 numbers from that array
multiply the first of the 6 numbers by 1.5
etc. as you have specified.
EDIT: Example code below:
Sub PickSixNumbers()
'Set variables:
Dim lBigArray(1 To 30) As Variant, lSmallArray(1 To 6) As Long
'Putting some fake values in here, over to you to fix this bit:
For a = 1 To 30
lBigArray(a) = a
Next
'Pick your numbers:
a = 1
Do Until a > 6
lSmallArray(a) = lBigArray(RndIntegerBetween(1, 30))
'If the selected number has already been selected, don't move to the next one
If CountInArray(lSmallArray, lSmallArray(a)) = 1 Then a = a + 1
Loop
'Multiply the first one by 1.5
lSmallArray(1) = lSmallArray(1) * 1.5
If WorksheetFunction.Sum(lSmallArray) > 0 And WorksheetFunction.Sum(lSmallArray) < 100 Then
Debug.Print "Sum is between 0 and 100"
Else
Debug.Print "Sum is not between 0 and 100"
Debug.Print "SHOCK HORROR"
End If
End Sub
'Helper Functions:
Function CountInArray(arr() As Long, Value As Long) As Long
CountInArray = 0
For a = LBound(arr) To UBound(arr)
If arr(a) = Value Then CountInArray = CountInArray + 1
Next
End Function
Function RndIntegerBetween(Min As Long, Max As Long) As Long
RndIntegerBetween = Int((Max - Min + 1) * Rnd + Min)
End Function
Closed. This question is not reproducible or was caused by typos. It is not currently accepting answers.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Closed 10 months ago.
Improve this question
this is my first question on StackOverflow, so bear with me if I get some of the procedure/posting standards incorrect.
My goal is to assign each student in the dataset a weighted average based on their test and quiz scores. Tests constitute 90% of this weighted average, and quizzes make up the remaining 10%. There is an additional caveat that if a test score is below 60, this score receives an additional 5 points (without changing the original test score). This entire process is to be done using a VBA programmed macro.
The problem I am having is that the calculated averages are wrong. (see picture, some scores are over 100 which should not be possible) I have tried to isolate the error by looking at the individual test and quiz averages, and so far I believe the error lies in the calculation of the test average but I'm not quite sure what exactly the problem is. Even when I remove the if statement that accounts for the "curve" I still end up with scores over 100. This makes me think there is an issue with the way I am calculating the averages. I have provided the code for my macro below. If there are any other problems with how I wrote this macro, please let me know I am still new to VBA.
Sub SetTwo()
Dim gradeAvg As Integer
Dim testAvg As Double
Dim quizAvg As Double
For i = 2 To 104
gradeAvg = 0
testAvg = 0
quizAvg = 0
For j = 6 To 13
If j <= 8 Then
If Worksheets("Set2").Cells(i, j) < 60 Then
testAvg = testAvg + Worksheets("Set2").Cells(i, j) + 5
Else
testAvg = testAvg + Worksheets("Set2").Cells(i, j)
End If
Else
quizAvg = quizAvg + Worksheets("Set2").Cells(i, j)
End If
Next j
testAvg = (testAvg / 300) * 90
quizAvg = (quizAvg / 100) * 10
gradeAvg = testAvg + quizAvg
Worksheets("Set2").Cells(i, 13) = gradeAvg
Next i
End Sub
Here is a sample of the dataset, with the averages calculated incorrectly
This is a tad bit embarassing. After playing around with the code a little more, I found my issue. It seems the bound for my inner for loops was wrong. I included the cell that contains the "average" value which ended up distorting my calculations and resulted in my calculated values going over 100.
For those interested, I have included the code for the correct macro below:
Sub SetTwo()
Dim gradeAvg As Integer
Dim testAvg As Double
Dim quizAvg As Double
For i = 2 To 104
gradeAvg = 0
testAvg = 0
quizAvg = 0
For j = 6 To 12
If j < 9 Then
If Worksheets("Set2").Cells(i, j) < 60 Then
testAvg = testAvg + Worksheets("Set2").Cells(i, j) + 5
Else
testAvg = testAvg + Worksheets("Set2").Cells(i, j)
End If
Else
quizAvg = quizAvg + Worksheets("Set2").Cells(i, j)
End If
Next j
testAvg = (testAvg / 300) * 90
quizAvg = (quizAvg / 100) * 10
gradeAvg = testAvg + quizAvg
Worksheets("Set2").Cells(i, 13) = gradeAvg
Next i
End Sub
the following sentence has 1 extra, it calculates including the "Average" cell
For j = 6 To 13
Should be j = 6 To 12
Hope it helps ! I did simulations and went good.
How can I generate random numbers 0 or 1 in 10 cells in the row, in which the sum of the random number is always equal to 7?
enter image description here
Here's a way to get seven "1"s and three "0"s in random order using RAND and RANK
In A1:J1: =RAND()
In A2:J2: =IF(RANK(A1,$A$1:$J$1,1)>3,1,0)
Available here is a version that I really think works! https://www.dropbox.com/s/ec431fu0h0fhb5i/RandomNumbers.xlsx?dl=0
And here's the '0 and 1' version (sheet 2 at the above link):
De-dup Rankings Randoms First Cut Sorted
0.47999002 7 0.479992063 1 1
0.68823003 3 0.688233075 1 1
0.07594004 9 0.075938331 1 1
0.02077005 10 0.020766892 1 0
0.69217006 2 0.692170173 1 0
0.73355007 1 0.733549516 1 1
0.51546008 6 0.515462872 1 1
0.62308009 4 0.623078278 0
0.33033001 8 0.330331577 1
0.561260011 5 0.561260557 1
Formulae for columns A-C exactly as before, D is just 7 1's, E is:
=VLOOKUP(ROW(E2)-1,B$1:D$11,3,FALSE)
Assuming that you want a list of positive random numbers that add to 7 you can use this following method.
Enter a 0 in the top-left cell (Blue Cell).
Enter =RAND()*7 into the next 9 cells below the 0 (Orange Cells).
Enter a 7 in the cell below the 9 random values (Blue Cell).
Copy the 9 random values and paste-special-values over top to turn the formulas into values.
Sort just these 9 cells in ascending order
In the cell just to the right of the first random value put a formula that subtracts the cell to the left and one above from the cell to the left (Yellow Cells).
Repeat this formula down to the cell next to the 7 that was typed in.
Sum the values in the second column (Green Cell).
That should give you 10 random values whose sum is exactly 7.
The only issue is that getting the values to be between 0 and 1 will take a bit of trial and error.
It appears that trial and error may not be practical. It's about a one in 2,710 times that this list will contain only numbers between 0 and 1. Not overly practical. Sorry.
To answer the question in the post, enter this in A1:J1 as an array formula (ctrl+shift+enter):
=1-(TRANSPOSE(MOD(SMALL(RANDBETWEEN(0,1e12*(ROW(INDIRECT("1:10"))>0))+(ROW(INDIRECT("1:10"))-1)/10,ROW(INDIRECT("1:10"))),1))>0.65)
To answer the question in the post title, do the following:
In A1:J1 enter:
=RAND()
In K1 enter:
=IF(SUM(A1:J1)<7,(7-SUM(A1:J1))/(COUNT(A1:J1)-7),7/SUM(A1:J1))
In L1 enter:
=IF(SUM($A1:$J1)<7,(A1+$K1)/($K1+1),A1*$K1)
Fill over to U1.
I believe the 10 numbers generated will be identically distributed in [0,1), but obviously not uniformly (I'm fairly certain the distribution does not have a name). The numbers can't be considered independent. A few statistics on the distribution:
Mean: 0.7 (as expected)
The other statistics are estimated from 10,000 simulations:
Variance: 0.0295
Kurtosis: -0.648
Skewness: -0.192
Think of it as drawing a sample of size 7 from the set {1, 2, ..., 10}. The 1s correspond to the numbers chosen for inclusion in the sample. Here is some VBA code which generates such samples:
Function sample(n As Long, k As Long) As Variant
'returns a variant of length n
'consisting of k 1s and n-k 0s
'thought of as a sample of {1,...,n} of size k
Dim v As Variant 'vector to hold sample
Dim numbers As Variant
Dim i As Long, j As Long, temp As Long
ReDim v(1 To n)
ReDim numbers(1 To n)
For i = 1 To n
v(i) = 0
numbers(i) = i
Next i
'do k steps of a Fisher-Yates shuffle on numbers
For i = 1 To Application.WorksheetFunction.Min(k, n - 1)
j = Application.WorksheetFunction.RandBetween(i, n)
If i < j Then 'swap
temp = numbers(i)
numbers(i) = numbers(j)
numbers(j) = temp
End If
Next i
'now use the first k elements of the partially shuffled array:
For i = 1 To k
v(numbers(i)) = 1
Next i
sample = v
End Function
Used like: Range("A1:J1").Value = sample(10,7)
Using a bit of brute force, I think I've got a workable solution to the original version of the question which asked for random numbers between 0 and 1.
Cells A1 to A9:
=rand()
Cell A10:
=7-sum(A1:A9)
Now you have 10 numbers that add up to 7, but the last one is probably not in the range 0 to 1. To deal with that, just recalculate the sheet to generate new random numbers until that last value is within range. It takes about 25 recalculations to have a ~95% chance that one of them will be within range, so it could take a while. A little VBA can do that for you very quickly:
Sub rand7()
While Range("A10").Value > 1 Or Range("A10").Value < 0
ActiveSheet.Calculate
Wend
End Sub
Inspired by this article: Statistics of Coin-Toss Patterns, I have conducted a Monte Carlo simulation for determining the expected number of tossing a coin to get a certain pattern by using Excel VBA. The following code is the Monte Carlo simulation for tossing a fair coin to get pattern HTH, where H is head (1) and T is tail (0).
Sub Tossing_Coin()
Dim Toss(1000000) As Double, NToss(1000000) As Double, AVToss(1000000) As Double
t0 = Timer
Sheet2.Cells.Clear
a = 0
For j = 1 To 1000000
p1 = Rnd()
If p1 <= 0.5 Then
Toss(1) = 1
Else
Toss(1) = 0
End If
p2 = Rnd()
If p2 <= 0.5 Then
Toss(2) = 1
Else
Toss(2) = 0
End If
i = 2
Do
p3 = Rnd()
If p3 <= 0.5 Then
Toss(i + 1) = 1
Else
Toss(i + 1) = 0
End If
i = i + 1
Loop Until Toss(i - 2) = 1 And Toss(i - 1) = 0 And Toss(i) = 1
NToss(j) = i
a = a + NToss(j)
AVToss(j) = a / j
b = AVToss(j)
Next j
MsgBox "The expected number of tossing is " & b & "." _
& vbNewLine & "The running time of simulation is " & Round(Timer - t0, 2) & " s."
End Sub
The output of the program is as shown below:
which agrees with the result as shown in the article. Other patterns for tossing a fair coin are also match. Despite the results, I'm still feeling uncertain whether the program I wrote is correct or not. My doubt arises when the coin is unfair, meaning p1, p2, and p3 are not equal to 0.5, since I don't have any information to check its accuracy. I also want to know how to write an efficient program in VBA Excel or R to perform simulation above for a longer pattern like THTHTHTHT, THTTHHTHTTH, etc. and its looping is more than 1,000,000 (maybe 100,000,000 or 1,000,000,000) but still pretty fast? Any idea?
To make it more efficient, you could use the bits of a variable by assigning a bit with a toss. Then for each toss, rotate the bits on the left and add the toss result at the first position until the bits on the right are a match with the pattern :
pattern "HTH" : 101
mask for "XXX" : 111
1 toss "H" : 1 And 111 = 001
2 toss "T" : 10 And 111 = 010
3 toss "T" : 100 And 111 = 100
4 toss "H" : 1001 And 111 = 001
5 toss "H" : 10011 And 111 = 011
6 toss "T" : 100110 And 111 = 110
7 toss "H" : 1001101 And 111 = 101 : "HTH" matches the first 3 bits
Note that VBA doesn't have a bit shift operator, but shifting 1 bit on the left is the same as multiplying by 2 :
decimal 9 = 1001 in bits
9 + 9 = 18 = 10010 in bits
18 + 18 = 36 = 100100 in bits
Here is an example to get the average number of toss to match a sequence:
Sub UsageExample()
Const sequence = "HTH"
Const samples = 100000
MsgBox "Average: " & GetTossingAverage(sequence, samples)
End Sub
Function GetTossingAverage(sequence As String, samples As Long) As Double
Dim expected&, tosses&, mask&, tossCount#, i&
Randomize ' Initialize the random generator. '
' convert the [TH] sequence to a sequence of bits. Ex: HTH -> 00000101 '
For i = 1 To Len(sequence)
expected = expected + expected - (Mid$(sequence, i, 1) = "T")
Next
' generate the mask for the rotation of the bits. Ex: HTH -> 01110111 '
mask = (2 ^ (Len(sequence) * 2 + 1)) - (2 ^ Len(sequence)) - 1
' iterate the samples '
For i = 1 To samples
tosses = mask
' generate a new toss until we get the expected sequence '
Do
tossCount = tossCount + 1
' rotate the bits on the left and rand a new bit at position 1 '
tosses = (tosses + tosses - (Rnd < 0.5)) And mask
Loop Until tosses = expected
Next
GetTossingAverage = tossCount / samples
End Function
You'll need one string to store pattern you want to find.
Then after each toss append latest result onto end of results string.
Then check if last n digits of results string == pattern where n = length of pattern.
If match then record numbers of tosses and blank results string and go again ...
You could probably do it in about 20 lines of code! Hope that helps.
I'm trying to solved a system of equations that results from estimating a 4th order differential equation. To do this requires creating a large matrix (A), usually 105 x 105, taking the inverse and multiplying by a 105 x 1 matrix (B). To do this, I'm using the linear algebra approach solving Ax = B.
Running the following code:
Dim A(1 To 105, 1 To 105) As Double
Dim B(1 To 105) As Double
Dim i As Integer
' Used to make sure all values of A are initialized to zero
For i = 1 To 105
For j = 1 To 105
A(i, j) = 0
Next
Next
For i = 1 To 105
A(i, i) = EI
A(i, i + 1) = -4 * EI + axial * h ^ 2
A(i, i + 2) = 6 * EI - 2 * axial * h ^ 2 + km(i) * h ^ 4
A(i, i + 3) = -4 * EI + axial * h ^ 2
A(i, i + 4) = EI
B(i) = W * h ^ 4
Next
Dim x(1 To 105) As Variant
x = Application.WorksheetFunction.MMult((Application.WorksheetFunction.MInverse(A)), B)
results in "Run-time error '1004': Unable to get the MInverse property of the WorksheetFunction class"
I've explored this error and it appears that it means I'm passing bad data to the function either text or blank values so I added the two loops at the top to initialize matrix A to 0 however this did nothing. After exploring some more I found some obscure post about a maximum size of matrices being 52 x 52 but wasn't able to find any more information about this.
Yes, there is a limit of 52 x 52, as mentioned in the official documentation.
https://msdn.microsoft.com/en-us/library/microsoft.office.interop.excel.worksheetfunction.minverse.aspx
EDIT
The documentation seems to be wrong. I tested =MINVERSE(A1:DA105) and it works well.
Very likely your matrix contains numbers that generate very large numbers and it fails. I populated my matrix 105 rows with numbers from 1 to 105 and it was failing. Then I put =RAND() in all the cells and it worked.
If the large numbers are the problem, perhaps there are tricks like populating the matrix with the logarithm of the numbers. It's a trick I use in other cases, I don't know if it can be used with a matrix.