Related
I need to sort a column containing cells with the following format : "TITLE text". I know the list of possible titles, but not the texts, so what I would like to do is sort the title in a custom order (for example : PLA, ARG, FHI, BRT) that is not alphabetical. The problem is that the title and the text are in the same cell.
So, for example, here is a screen of datas I might want to work on :
How can I sort this if the cells doesn't perfectly match the list members ?
And, if possible, how to do that using a macro and not manually ?
It's not very difficult. I will try to explain how this is done.
First of all, we need to figure out a way to transfer the range of cells to be sorted to the macro. There are different ways - write the address directly in the macro code, pass it as a parameter to the UDF, get it from the current selection. We use the third method - it is not the easiest to code, but it will work with any data sets.
The main difficulty when using the current selection is that the selection can be one single cell (nothing to sort), a range of cells (and may be several columns - how to sort this?) or several ranges of cells (this is if you hold down the CTRL key and select several unconnected ranges).
A good macro should handle each of these situations. But now we are not writing a good macro, we are getting acquainted with the principle of solving such problems (Since StackOfflow is a resource for programmers, the answers here help you write code yourself, and not get ready-made programs for free). Therefore, we will ignore a single cell and
multiple ranges - we will just stop execution of macro. Moreover, if there is more than one column in the selected range, then we will not do anything either.
Also, in case a full column is selected, we restrict the range to be sorted to the used area. This will sort the real data, but not the million empty cells.
The code that does all this looks like this:
Sub SortByTitles()
Dim oCurrentSelection As Variant
Dim oSortRange As Variant
Dim oSheet As Variant
Dim oCursor As Variant
Dim oDataArray As Variant
Dim sList As String
sList = "PLA,ARG,FHI,BRT"
oCurrentSelection = ThisComponent.getCurrentSelection()
Rem Is it one singl cell?
If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCell") Then Exit Sub
Rem Is it several ranges of cells?
If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRanges") Then Exit Sub
Rem Is this one range of cells? (It can be a graphic item or a control.
Rem Or it may not even be a Calc spreadsheet at all)
If Not oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
Rem Is there only one column selected?
If oCurrentSelection.getColumns().getCount() <> 1 Then Exit Sub
Rem Is the current selection outside of the used area?
oSheet = oCurrentSelection.getSpreadsheet()
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
oSortRange = oCursor.queryIntersection(oCurrentSelection.getRangeAddress())
If oSortRange.getCount() <> 1 Then Exit Sub
Rem Redim oSortRange as single range (not any ranges)
oSortRange = oSortRange.getByIndex(0)
Rem Get data from oSortRange
oDataArray = oSortRange.getDataArray()
Rem Paste sorted data to the same place:
oSortRange.setDataArray(getSorted(oDataArray, Split(sList,",")))
End Sub
The getSorted() function, which is mentioned in the last line of the procedure, must take two arrays as parameters — the values of the cells to be sorted and the sort list — and return one array of sorted values.
One aspect of working with data from ranges of cells should be mentioned here. If in Excel after receiving data from the range we get a two-dimensional array, then in OpenOffice/LibreOffice we get a one-dimensional "array of arrays", each element of which is a one-dimensional array of cell values of one row. Writing to a range is done from exactly the same structure, from an "array of arrays". The first parameter of the getSorted() function is oDataArray - just such an array of arrays, this will need to be taken into account when processing data.
What will getSorted() function do? It will build a "tree" sorted by Headers from the oDataArray values. In fact, this is not a tree - it is an ascending sorted array of all Headers and all values with these Headers. The values are also a sorted array. Then the function will select from the tree those Headings that are listed in the List and remove them from the tree. If, after all the actions, some elements still remain in the sorted tree, they will be displayed at the very end.
The function will accumulate the result in a separate array of the same size as the original one. In other words, the algorithm will use three times more memory than the original sorted range - source data, a tree and result array. The function will accumulate the result in a separate array of the same size as the original one. In other words, the algorithm will use three times more memory than the original sorted range - source data, a tree and result array.
You can try to save resources and write the results directly to the original array. But I strongly advise against doing this.
The fact is that an array cell may contain not a value, but a reference to a value, and in the case of inaccurate coding, you will not get a large sorted array, but a large array of the same value (the last cell).
I deliberately do not comment on all the following code - if you can read and understand this without comment, then you will understand how actions are programmed to process data from ranges:
Function getSorted(aData As Variant, aList As Variant) As Variant
Dim aRes As Variant
Dim i As Long, pos As Long, j As Long, k As Long, m As Long, uB As Long
Dim aTemp As Variant
aTemp = Array()
ReDim aRes(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
pos = InStr(aData(i)(0), " ")
If pos > 0 Then
AddToArray(Left(aData(i)(0),pos-1), aData(i)(0), aTemp)
Else
AddToArray(aData(i)(0), aData(i)(0), aTemp)
EndIf
Next i
m = LBound(aData) - 1
For i = LBound(aList) To UBound(aList)
k = getIndex(aList(i), aTemp)
If k > -1 Then
uB = UBound(aTemp) - 1
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
For j = k To uB
aTemp(j) = aTemp(j+1)
Next j
ReDim Preserve aTemp(uB)
EndIf
Next i
For k = LBound(aTemp) To UBound(aTemp)
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
Next k
getSorted = aRes
End Function
To build a sorted tree, two subroutines are used - AddToArray() and InsertToArray(). They are very similar - the first eight lines are a normal binary search, and the remaining 10-12 lines are actions when an element is not found at the end of the array, when it is found and when it is not found in the middle of the array:
Sub AddToArray(key As Variant, value As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = Array(key, Array(value))
ElseIf aData(r)(0)=key Then
InsertToArray(value, aData(r)(1))
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = Array(key, Array(value))
EndIf
End Sub
Sub InsertToArray(key As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = key
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = key
EndIf
End Sub
The getIndex() function uses the same binary search. It will return the index of the element in the array if it can find it, or -1 otherwise:
Function getIndex(key As Variant, aData As Variant) As Long
Dim l&, r&, m&, N&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
getIndex = -1
ElseIf aData(r)(0)=key Then
getIndex = r
Else
getIndex = -1
EndIf
End Function
And that's all that is needed to solve the task:
Demo file with code - SortByTitle.ods
I have this setup here:
'highest number of days and lowest
niedrigsterTag = 8
hoechsterTag = 8
dim tageV(), tageB()
redim tageV(7), tageB(7)
'day-mapping
tageV(0) = replace(rs("TagVon"),"Mo", 1)
tageV(1) = replace(rs("TagVon"),"Di", 2)
tageV(2) = replace(rs("TagVon"),"Mi", 3)
tageV(3) = replace(rs("TagVon"),"Do", 4)
tageV(4) = replace(rs("TagVon"),"Fr", 5)
tageV(5) = replace(rs("TagVon"),"Sa", 6)
tageV(6) = 7
'for example: mo - fr
for each item in tageV
'save smallest weekday
if(isNumeric(item)) then
if(item <= niedrigsterTag) then
niedrigsterTag = item
Response.write(niedrigsterTag)
response.end()
end if
end if
next
As you might see, I'm pretty new into classic ASP. I don't understand what I'm missing on my loop. In pseudocode, it looks fine:
for each numeric value in my array, check if the current value of item is <= the current maxValue (hoechsterTag) - which is in the first iteration 8. If so, override the current value.
Now I'm stuck. I added a response.end() in the most-inner if. However, niedrigsterTag has a value of 7 instead of 1. Also, during the 1st iteration, item should be 1, right? For me it is 7. I imagined response.end() is an equivalent to PHP's die()
What I'm trying to realize:
if current iteration < current value, override it, so I'm ending up with the smallest value.
I know this is pretty basic, and so far I hadn't problems doing stuff like this in other languages. Don't know why this makes it so special.
Thank you for any hints and advices
When you are assigning the values to your tageV array, you are assigning them as strings and then comparing them to integers. You need to compare like datatypes for one.
Also, they way it is written is like this: In the first iteration, if the item is 1 and niedrigsterTag is 8 then niedrigsterTag is changed to 1 and response.end stops the loop and exits. What you need is more like this:
'highest number of days and lowest
niedrigsterTag = 8
hoechsterTag = 8
dim tageV(), tageB()
redim tageV(7), tageB(7)
'day-mapping
tageV(0) = replace(rs("TagVon"),"Mo", 1)
tageV(1) = replace(rs("TagVon"),"Di", 2)
tageV(2) = replace(rs("TagVon"),"Mi", 3)
tageV(3) = replace(rs("TagVon"),"Do", 4)
tageV(4) = replace(rs("TagVon"),"Fr", 5)
tageV(5) = replace(rs("TagVon"),"Sa", 6)
tageV(6) = 7
'for example: mo - fr
for each item in tageV
'save smallest weekday
if(CInt(item) <= niedrigsterTag) then
niedrigsterTag = CInt(item)
end if
next
Response.write("niedrigsterTag = " & niedrigsterTag)
This loops through the array and every time it finds a smaller value, the variable is assigned that value. Once the loop is done, the variable will hold the smallest value.
By the way, the reason you were getting 7 was because that was the only value that was making it past the if statements.
Here's part of my code.
<%
Dim lineData,fso,filea,fileb,filec
s=request.querystring("query")
set fso = Server.CreateObject("Scripting.FileSystemObject")
a(0,0)=0
a(1,0)=" - Entries in File A"
set filea = fso.OpenTextFile(Server.MapPath("FileA.txt"), 1, true)
do until lone.AtEndOfStream
lineData = lcase(filea.ReadLine())
if instr(lineData,s)>0 then
a(0,0)=a(0,0)+1
end if
Loop
a(0,1)=0
a(1,1)=" - Entries in File B"
set fileb = fso.OpenTextFile(Server.MapPath("FileB.txt"), 1, true)
do until mile.AtEndOfStream
lineData = lcase(fileb.ReadLine())
if instr(lineData,s)>0 then
a(0,1)=a(0,1)+1
end if
Loop
a(0,2)=0
a(1,2)=" - Entries in File C"
set filec = fso.OpenTextFile(Server.MapPath("FileC.txt"), 1, true)
do until payne.AtEndOfStream
lineData = lcase(filec.ReadLine())
if instr(lineData,s)>0 then
a(0,2)=a(0,2)+1
end if
Loop
%>
The code essentially looks for the number of entries in a text file. What I need is it to be sorted such that the file with the most number of entries comes first.
Suppose there are 10 entries in FileA, 12 in FileB and 7 in FileC. I'd like the output to be displayed like this:
12 - Entries in File B
10 - Entries in File A
7 - Entries in File C
I'm guessing it won't be too complicated since response.write(a(0,i)&a(1,i)) will work. I just need help with the loop or any sorting method if there is one.
Any help I can get in here will be much appreciated.
This will be a "neo-answer" that should help you get to where you want to go, both in the short- and long-term.
1) First, a suggestion for further reading to help you address this sort of problem in a more general way -- and to help you develop your "chops" as you go. You can Google the term "bubble sort" and get a whole host of interesting and mostly helpful input, but here's a link you probably will find most directly helpful, from a brief series of articles on sorting from the 4 Guys from Rolla site, which back in the day was THE place for quality writing on ASP:
https://web.archive.org/web/20211020153403/https://www.4guysfromrolla.com/webtech/011601-1.shtml
You will see that there is a link to an introductory article at the top of this one that covers one-dimensional array sorting, and I recommend it as well. For one, it introduces another sort method, QuickSort, and having multiple tools in your toolbox is almost never a bad idea. (As you will discover, bubble sorting is often the easiest to envision and implement, but because its performance is essentially linear based on the number of items being sorted, can become a performance problem on larger datasets.) Go ahead, check it out; I'll wait 'til you get back...
2) OK, to give you a more concrete approach to address your specific situation here, if the number of files you're reviewing isn't going to be too large, you can do a sort of "final pass" sort to present your results in the desired order.
First, you'll want to introduce a simple global counting variable up toward the top of your code:
dim intMaxEntries
intMaxEntries = 0
Then, at the end of each of your file-parsing runs, you'll want to check the number of entries against intMaxEntries and update intMaxEntries if the number of entries just read in is greater.
if a(0, 1) > intMaxEntries then
intMaxEntries = a(0, 1)
end if
You'll do right after each file reading loop, so the comparison in the above snippet would be done for a(0, 1), a(1, 1), and a(2, 1). More on that repetitive logic at the end.
After you've done all the file reads, intMaxEntries will have the maximum number of entries you've found in one of the files. Then, you can just step down from that value and print out entry counts in the correct order when they match your countdown:
dim i, j
for i = intMaxEntries to 0 step -1
for j = 0 to ubound(a) 'By default gives the upper bound of the 1st dimen.
if a(j, 1) = i then
Response.Write i & a(j, 2) & "<BR>"
end if
next j
next i
This is more than a bit of a hack, and I would encourage you to opt instead for doing a proper sort of your array so that you have something more generalizably useful, but it will work to get you where you want to go, especially if the number of files -- or the maximum number of entries -- isn't too large. You could also clean up my example by introducing the possibility of breaking out of the loops when all the files are accounted for, but I'll let you figure out if that's necessary.
3) You may have just simplified the codebase to get the concept across more cleanly (for which I applaud you if true), but just in case, I would encourage you to look at ways to modularize your work by building your file reading functionality as a function that is simply called with the file and string comparison information needed. (Also, probably an artifact of your snipping, but the "lone", "mile" and "Payne" references in there don't make sense; assuming those are the FSOs you are instantiating and have just forgotten to change them to fileA, fileB and fileC.)
Hope that helps a bit,
Bret
#bret
Someone else came through.
Here's a code that worked perfectly.
Would this be an example of "bubble sort"?
for k=23 to 0 Step-1
for j=0 to k
if (a(0,j)<a(0,j+1)) then
t1=a(0,j+1)
t2=a(1,j+1)
a(0,j+1)=a(0,j)
a(1,j+1)=a(1,j)
a(0,j)=t1
a(1,j)=t2
end If
next
next
for i=0 to 24
if a(0,i)>0 then
response.write (a(0,i)&a(1,i)&"<br>")
end if
next
set objFSO = Server.CreateObject("Scripting.FileSystemObject")
set objFolder = objFSO.GetFolder(server.mappath("Files"))
set objfiles = objFolder.Files
Function filesearch(name)
set searchname = objFSO.OpenTextFile(server.mappath(filename),1, true)
do until searchname.AtEndOfStream
lineData = lcase(searchname.ReadLine())
if instr(lineData,s)>0 then
instances = instances + 1
end if
Loop
End Function
For Each objFile in objFolder.Files
filesearch(objFile)
Response.Write filename & "<br>" & instances & "<br>" & "<br>"
Next
Set objFolder = Nothing
Set objFSO = Nothing
There are a few rough edges but what really bothers me now is the sorting. Where do I keep the bubble sort code?
EDIT:
I've got it work perfect with the following code.
For Each objFile in objFolder.Files
filesearch(objFile)
i = i + 1
a(0,i) = instances
a(1,i) = filename
Next
I was also wondering if there's anyway I could also write the total number of instances. I was able to do it before with:
for i=0 to 43
entries=entries+a(0,i)
next
I cant seem to make it work now.
EDIT:
Works now with:
for i = 0 to n
entries = entries + a(0,i)
next
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