Ive been trying to write Access VBA code to automate the addition of replicates for germination tests.
Basically I have a form where I enter the total number of Reps (NoofReps) and the number of seeds per rep (RepSize) (e.g. 50 seeds). For each record added I want it to automatically add a record for each rep and automatically calc the Rep Number (i.e if i have 4 reps then it should add 4 records, numbered 1-4 reps) as well as the RepSize (e.g 50).
I have been trying out various loops based on information from this forum and other but am still getting errors with the number of records that it generates. I have tried both the "Do while" and "Do Until" but get the same result below either way.
Could someone please let me know where I am going wrong?...If i want 2 reps then it adds 2, If i want 3 then its 246, and if i want 4 it adds >30,000!!!
For the purposes of trying to fix the code I have started to type the number of reps manually into the code in the iNoofReps so that I know the error is in the code and not from the form.
Private Sub CmdAddReps3_Click()
Dim iRepNo As Integer ' stores the current value in the series
'Open the table
Set db = CurrentDb()
Set rstGReps = db.OpenRecordset("tblGReplicates")
' Initialise the variables
iRepNo = 1
iNoofReps = 3 'iNoofReps = Me.txtNoofReps
' Add the records using a loop
rstGReps.movefirst
Do 'Until rstGReps("RepNo") = (iNoofReps + 1) ' always want to include at least 1 repNo
rstGReps.AddNew
rstGReps("GTestID") = Me.GTestID
rstGReps("RepNo") = iRepNo
rstGReps("NoofSeed") = Me.txtNoOfSeeds
' Calculate the next RepNo value in the loop
iRepNo = iRepNo + 1
rstGReps.Update
rstGReps.moveNext
Loop Until rstGReps("RepNo") = (iNoofReps) + 1 ' so that the loop includes the final repNo.
MsgBox "Finished Looping"
rstGReps.Close
Set rstGReps = Nothing
Set db = Nothing
End Sub
Any help would be appreciated!!!
Well, you're moving next here: rstGReps.moveNext, and then you're comparing rstGReps("RepNo") = (iNoofReps) + 1 after moving next, thus being on an empty record, thus always equating to false.
Loop Until iRepNo = (iNoofReps) + 1 should fix it, then you're no longer referring to the recordset, which has already been set to the next record by the time you're referring to it.
You could also fix it by just eliminating this line:
rstGReps.moveNext
Since rstGReps.AddNew already moves the recordset to a new blank record, moving it forward after adding the record doesn't make much sense. If you remove it, you might want to remove the + 1 in Loop Until rstGReps("RepNo") = (iNoofReps) + 1
Keep getting this error sometimes when mid is ZERO:
Invalid procedure call or argument: 'Mid'
How would I fix this?
Function CreateRandomString(iSize)
Const VALID_TEXT = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
Dim sNewSearchTag
Dim I
For I = 0 To iSize
Randomize
sNewSearchTag = sNewSearchTag & Mid(VALID_TEXT,Round(Rnd * Len(VALID_TEXT)),1)
Next
CreateRandomString = sNewSearchTag
End Function
For the random range to be correct you need to make sure the random value generated is between 1 and the length of the VALID_TEXT string value.
The simple formula to do this using Rnd() is
(Rnd() * Len(VALID_TEXT)) + 1
also move Randomize() outside the loop, as it is you'll just make it less random as you're resetting the seed with every iteration of the loop.
The reason for the error is Mid() expects a valid start and size, which a zero value is not. See this question for more information.
More information about random number ranges can be found in this answer to another question.
The second argument of Mid is 1 based. That means that if you did:
Mid(VALID_TEXT,1,1)
you will get "a", not "b" as you might be expecting.
An easy fix would be to add 1 to the second argument, but then you'll run into the same problem on the top end. Typically people will round a random number down after multiplying it instead of using Math.Round, either view Math.Floor or Integer truncation.
in VBScript, we can loop between 2 dates, using:
for k = date() to date()+4
...
next
But if I want the loop to be in reverse, neither of the following work:
for k = date()+4 to date()
for k = date() to date()-4 step-1
They just give an empty loop.
Is there a way to do this? I need the dates in descending order.
Really?, your last example works for me.
Would have posted this as a comment but wanted to show the output working, your code seems fine.
Dim k
For k = Date() To Date() - 4 Step - 1
WScript.Echo k
Next
Output:
21/03/2016
20/03/2016
19/03/2016
18/03/2016
17/03/2016
I got this comma separated file with a bunch of numbers
The only thing that I need to be able to do is to find what number that appears the most time
Ex:
817;9;516;11;817;408;9;817
then the result will be 817
I hope you understand what I am trying to do.
I would suggest using the FileSystemObjects, specifically the OpenTextFile method to read the file, then use split function to separate based on columns. Then iterate the array returned, and count the number of times each number occurs.
The following code will count your array for you. It uses the useful Dictionary object.
Set counts = CreateObject("Scripting.Dictionary")
For i = Lbound(arr) to Ubound(arr)
If Not counts.Exists(arr(i)) Then
counts.add arr(i), 1
Else
currCount = counts.Item(arr(i))
counts.Item(arr(i)) = currCount + 1
End If
Next
nums = counts.Keys()
currMax = 0
currNum = 0
For i = Lbound(nums) to Ubound(nums)
If counts.Item(nums(i)) > currMax Then
currMax = counts.Item(nums(i))
currNum = nums(i)
End If
Next
num = currNum ' Most often found number
max = currMax ' Number of times it was found
i would go through the text and count the number of your nubmers.
after that i would redim an dynamic array.
- go throught the text from beginning to end, and store them in the array.
after that i would pick the first number, go through the array and count (for example in tmpcounter) the number of dublicates. [you could store the counted number from the textfile in tmphit]
the you pick the second number, count the number of dublicates ( tmpcounter2 /tmphit2)
compare the two counters,you "keep" the higher one and use the lowe one for the next number
...go on until the last field is validated.
at the end you know which number appearse most and how often.
i hope this help you.
this is how i would programm it, maybe there is a better way or an API.
at the end you know
Try this
Set objFile = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Test.txt",1)
Set dictNumbers = CreateObject("Scripting.Dictionary")
Dim MostKey
intHighest = -1
do while NOT objFile.AtEndOfStream
LineArray = Split(objFile.ReadLine,";")
for i = 0 to UBound(LineArray)
if dictNumbers.Exists(LineArray(i)) Then
dictNumbers.Item(LineArray(i)) = dictNumbers.Item(LineArray(i)) + 1
else
dictNumbers.Add LineArray(i), 1
end if
if dictNumbers.Item(LineArray(i)) > intHighest Then
intHeighest = dictNumbers.Item(LineArray(i))
MostKey = LineArray(i)
end if
next
Loop
MsgBox MostKey
I am trying to create an application that will calculate the cost of exotic parimutuel wager costs. I have found several for certain types of bets but never one that solves all the scenarios for a single bet type. If I could find an algorithm that could calculate all the possible combinations I could use that formula to solve my other problems.
Additional information:
I need to calculate the permutations of groups of numbers. For instance;
Group 1 = 1,2,3
Group 2 = 2,3,4
Group 3 = 3,4,5
What are all the possible permutation for these 3 groups of numbers taking 1 number from each group per permutation. No repeats per permutation, meaning a number can not appear in more that 1 position. So 2,4,3 is valid but 2,4,4 is not valid.
Thanks for all the help.
Like most interesting problems, your question has several solutions. The algorithm that I wrote (below) is the simplest thing that came to mind.
I found it easiest to think of the problem like a tree-search: The first group, the root, has a child for each number it contains, where each child is the second group. The second group has a third-group child for each number it contains, the third group has a fourth-group child for each number it contains, etc. All you have to do is find all valid paths from the root to leaves.
However, for many groups with lots of numbers this approach will prove to be slow without any heuristics. One thing you could do is sort the list of groups by group-size, smallest group first. That would be a fail-fast approach that would, in general, discover that a permutation isn't valid sooner than later. Look-ahead, arc-consistency, and backtracking are other things you might want to think about. [Sorry, I can only include one link because it's my first post, but you can find these things on Wikipedia.]
## Algorithm written in Python ##
## CodePad.org has a Python interpreter
Group1 = [1,2,3] ## Within itself, each group must be composed of unique numbers
Group2 = [2,3,4]
Group3 = [3,4,5]
Groups = [Group1,Group2,Group3] ## Must contain at least one Group
Permutations = [] ## List of valid permutations
def getPermutations(group, permSoFar, nextGroupIndex):
for num in group:
nextPermSoFar = list(permSoFar) ## Make a copy of the permSoFar list
## Only proceed if num isn't a repeat in nextPermSoFar
if nextPermSoFar.count(num) == 0:
nextPermSoFar.append(num) ## Add num to this copy of nextPermSoFar
if nextGroupIndex != len(Groups): ## Call next group if there is one...
getPermutations(Groups[nextGroupIndex], nextPermSoFar, nextGroupIndex + 1)
else: ## ...or add the valid permutation to the list of permutations
Permutations.append(nextPermSoFar)
## Call getPermutations with:
## * the first group from the list of Groups
## * an empty list
## * the index of the second group
getPermutations(Groups[0], [], 1)
## print results of getPermutations
print 'There are', len(Permutations), 'valid permutations:'
print Permutations
This is the simplest general formula I know for trifectas.
A=the number of selections you have for first; B=number of selections for second; C=number of selections for third; AB=number of selections you have in both first and second; AC=no. for both first and third; BC=no. for both 2nd and 3rd; and ABC=the no. of selections for all of 1st,2nd, and third.
the formula is
(AxBxC)-(ABxC)-(ACxB)-(BCxA)+(2xABC)
So, for your example ::
Group 1 = 1,2,3
Group 2 = 2,3,4
Group 3 = 3,4,5
the solution is:: (3x3x3)-(2x3)-(1x3)-(2x3)+(2x1)=14. Hope that helps
There might be an easier method that I am not aware of. Now does anyone know a general formula for First4?
Revised after a few years:-
I re logged into my SE account after a while and noticed this question, and realised what I'd written didn't even answer you:-
Here is some python code
import itertools
def explode(value, unique):
legs = [ leg.split(',') for leg in value.split('/') ]
if unique:
return [ tuple(ea) for ea in itertools.product(*legs) if len(ea) == len(set(ea)) ]
else:
return [ tuple(ea) for ea in itertools.product(*legs) ]
calling explode works on the basis that each leg is separated by a /, and each position by a ,
for your trifecta calculation you can work it out by the following:-
result = explode('1,2,3/2,3,4/3,4,5', True)
stake = 2.0
cost = stake * len(result)
print cost
for a superfecta
result = explode('1,2,3/2,4,5/1,3,6,9/2,3,7,9', True)
stake = 2.0
cost = stake * len(result)
print cost
for a pick4 (Set Unique to False)
result = explode('1,2,3/2,4,5/3,9/2,3,4', False)
stake = 2.0
cost = stake * len(result)
print cost
Hope that helps
AS a punter I can tell you there is a much simpler way:
For a trifecta, you need 3 combinations. Say there are 8 runners, the total number of possible permutations is 8 (total runners)* 7 (remaining runners after the winner omitted)* 6 (remaining runners after the winner and 2nd omitted) = 336
For an exacta (with 8 runners) 8 * 7 = 56
Quinellas are an exception, as you only need to take each bet once as 1/2 pays as well as 2/1 so the answer is 8*7/2 = 28
Simple
The answer supplied by luskin is correct for trifectas. He posed another question I needed to solve regarding First4. I looked everywhere but could not find a formula. I did however find a simple way to determine the number of unique permutations, using nested loops to exclude repeated sequences.
Public Function fnFirst4PermCount(arFirst, arSecond, arThird, arFourth) As Integer
Dim intCountFirst As Integer
Dim intCountSecond As Integer
Dim intCountThird As Integer
Dim intCountFourth As Integer
Dim intBetCount As Integer
'Dim arFirst(3) As Integer
'Dim arSecond(3) As Integer
'Dim arThird(3) As Integer
'Dim arFourth(3) As Integer
'arFirst(0) = 1
'arFirst(1) = 2
'arFirst(2) = 3
'arFirst(3) = 4
'
'arSecond(0) = 1
'arSecond(1) = 2
'arSecond(2) = 3
'arSecond(3) = 4
'
'arThird(0) = 1
'arThird(1) = 2
'arThird(2) = 3
'arThird(3) = 4
'
'arFourth(0) = 1
'arFourth(1) = 2
'arFourth(2) = 3
'arFourth(3) = 4
intBetCount = 0
For intCountFirst = 0 To UBound(arFirst)
For intCountSecond = 0 To UBound(arSecond)
For intCountThird = 0 To UBound(arThird)
For intCountFourth = 0 To UBound(arFourth)
If (arFirst(intCountFirst) <> arSecond(intCountSecond)) And (arFirst(intCountFirst) <> arThird(intCountThird)) And (arFirst(intCountFirst) <> arFourth(intCountFourth)) Then
If (arSecond(intCountSecond) <> arThird(intCountThird)) And (arSecond(intCountSecond) <> arFourth(intCountFourth)) Then
If (arThird(intCountThird) <> arFourth(intCountFourth)) Then
' Debug.Print "First " & arFirst(intCountFirst), " Second " & arSecond(intCountSecond), "Third " & arThird(intCountThird), " Fourth " & arFourth(intCountFourth)
intBetCount = intBetCount + 1
End If
End If
End If
Next intCountFourth
Next intCountThird
Next intCountSecond
Next intCountFirst
fnFirst4PermCount = intBetCount
End Function
this function takes four string arrays for each position. I left in test code (commented out) so you can see how it works for 1/2/3/4 for each of the four positions