Permutations

[howard]

I have a series of numbers in an excel spreadsheet for eg 6, 11,7,28,23,28,45,47,41,35,38
where I want to determine the number permutations.

The criteria is as follows:

1) The maximum number number in any row/cell is 6 for eg 1, 18, 23, 38, 45, 49

2) No number must occur more than once in a cell for eg the number 11, 11 must now be allowed


It would be appreciated if you would provide me wth VBA code that will allow me to do the above

Once the Macro has been activated the data should look similar to this

11, 7, 17, 28, 23, 28
11, 7, 17, 28, 23, 45
11, 7, 17, 28, 23, 47

Howard

 

[CARBOB]

I deleted ref statement. I posted the wrong error. It stops @ VSrotMA Sub function not defined!

Private Sub VSortMA(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSrotMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub

 

[jindon]

I deleted ref statement. I posted the wrong error. It stops @ VSrotMA Sub function not defined!

You don't have any word like "VSrotMA" in the code.

Copy the code again and try

 

[CARBOB]

This is the onlycode I see.


Sub test()
Dim a, i As Long, ii As Long, b(1 To 15, 1 To 7)
a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
Randomize
For i = 1 To 15
For ii = 1 To UBound(a, 1): a(ii, 2) = Rnd: Next
VSortMA a, 1, UBound(a, 1), 2
b(i, 1) = "Permutations#" & i
For ii = 2 To 7: b(i, ii) = a(ii - 1, 1): Next
Next
Range("b1").Resize(15, 7).Value = b
End Sub

Private Sub VSortMA(ary, LB, UB, ref)Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = UB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSrotMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub

 

[CARBOB]

Vsort wasmisspelled. Now, I get an error at the statement in bold.

Sub test()
Dim a, i As Long, ii As Long, b(1 To 15, 1 To 7)
a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
Randomize
For i = 1 To 15
     For ii = 1 To UBound(a, 1): a(ii, 2) = Rnd: Next
     VSortMA a, 1, UBound(a, 1), 2
     b(i, 1) = "Permutations#" & i
     For ii = 2 To 7: b(i, ii) = a(ii - 1, 1): Next
Next
Range("b1").Resize(15, 7).Value = b
End Sub

Private Sub VSortMA(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = UB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
     Do While ary(ii, ref) < M          ii = ii + 1
     Loop
     Do While ary(i, ref) > M
          i = i - 1
     Loop
     If ii <= i Then
          For iii = LBound(ary, 2) To UBound(ary, 2)
               temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
          Next
          ii = ii + 1: i = i - 1
     End If
Loop
If LB < i Then VSortMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub

 

[jindon]

Sub test()
Dim a, i As Long, ii As Long, b(1 To 15, 1 To 7)
a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
Randomize
For i = 1 To 15
     For ii = 1 To UBound(a, 1): a(ii, 2) = Rnd: Next
     VSortMA a, 1, UBound(a, 1), 2
     b(i, 1) = "Permutations#" & i
     For ii = 2 To 7: b(i, ii) = a(ii - 1, 1): Next
Next
Range("b1").Resize(15, 7).Value = b
End Sub

Private Sub VSortMA(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = LB '<- this line was wrong!
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
     Do While ary(ii, ref) < M
          ii = ii + 1
     Loop
     Do While ary(i, ref) > M
          i = i - 1
     Loop
     If ii <= i Then
          For iii = LBound(ary, 2) To UBound(ary, 2)
               temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
          Next
          ii = ii + 1: i = i - 1
     End If
Loop
If LB < i Then VSortMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub

 

[CARBOB]

I get a run time error"9", subscript out of range @ Bold line



Sub test()
Dim a, i As Long, ii As Long, b(1 To 15, 1 To 7)
a = Range("a1", Range("a" & Rows.Count).End(xlUp)).Resize(, 2).Value
Randomize
For i = 1 To 15
For ii = 1 To UBound(a, 1): a(ii, 2) = Rnd: Next
VSortMA a, 1, UBound(a, 1), 2
b(i, 1) = "Permutations#" & i
For ii = 2 To 7: b(i, ii) = a(ii - 1, 1): Next
NextRange("b1").Resize(15, 7).Value = b
End Sub

Private Sub VSortMA(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long, temp
i = UB: ii = LB '<- this line was wrong!
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
Do While ary(ii, ref) < M
ii = ii + 1
Loop
Do While ary(i, ref) > M
i = i - 1
Loop
If ii <= i Then
For iii = LBound(ary, 2) To UBound(ary, 2)
temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
Next
ii = ii + 1: i = i - 1
End If
Loop
If LB < i Then VSortMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub

 

[jindon]

How many numbers do you have in column A?

 

[CARBOB]

3


300
201
102

How many numbers do you have in column A?

 

[jindon]

3


300
201
102

How many numbers do you have in column A?

Impossible with 3 numbers.

Need more than 6 numbers at least

 

[CARBOB]

Re: Help With Macro

This is my original post, did you not read it. Are you saying there's no way to create the combinations shown in Col's C:G, but by hand?

I found this Macro on the forum and I want to know if it will work for what I need. In Col A, I have 3 sets of numbers. I want to create all the different Combinations or Permutation with only 5 in a row, likethe ones in Col's C to G. I know very little Excel and nothing about Macros. Thanks for all suggestions.

PERMUTATIONS.xls
	A	B	C	D	E	F	G	H	I
1	300		300	300	300	300	300
2	201		201	201	201	201	201
3	102		102	102	102	102	102
4			300	300	300	300	201
5
6
7
8
Sheet1

If you are selecting N items many times, this new edit will make things faster.
If you are doing truly massive numbers of selections (10,000+ choices, showing 15+ elements per choice) this will run into memory issues and the current one is better (after numChoicesMade is dimensioned Long). But if you are below that number, this speeds things up in the 200 - 10,000 choice range.

Rem - - - - - - begin New Edit - - - - - - - - - - -

Rem where to start writing
    Set writeRay = ThisWorkbook.Sheets(1).Range("c2")
    Set writeRay = Range(writeRay, _
                    writeRay.Cells(numChoicesMade, elementsPerChoice))

Dim outputRRay As Variant
ReDim outputRRay(1 To numChoicesMade, 1 To elementsPerChoice)

Application.Calculation = xlManual
Application.ScreenUpdating = False

Rem permutation  routine
    For j = 1 To numChoicesMade
    
    Rem randomly re-order selectFrom
        maxIndex = UBound(selectFrom) + 1
        For i = 1 To elementsPerChoice
            randIndex = i + Int(Rnd() * (maxIndex - i))
            
            temp = selectFrom(randIndex)
            selectFrom(randIndex) = selectFrom(i)
            selectFrom(i) = temp
            
            outputRRay(j, i) = selectFrom(i)
        Next i
        
    Next j
    writeRay.Value = outputRRay
    
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub