Permutation in excel

[Sweden]

Hallo everybody!

I´ve a vba code now that can generate combinations in excel but when it
will com to the end of the rows, that means 65500(or something like
that), I have built in code that order it to continue on another
worksheet and it works but something is wrong. In the first worksheet
it writes all combinations OK but on the next worksheet it do not work,
what is wrong?
Do any body can help with sloving this problem?
Here is the code:

Sub aa()
Dim i, j, k, l, m, n, o, rw, summ, summ133, dif

rw = 1

For i = 1 To 19

For j = i + 1 To 24

For k = j + 1 To 26

For l = k + 1 To 30

For m = l + 1 To 33

For n = m + 1 To 34

For o = n + 1 To 35

summ = i + j + k + l + m + n + o

dif = o - i

If ((summ > 98) And (summ < 106) And (dif > 13)) Then

Cells(rw, 1) = i

Cells(rw, 2) = j

Cells(rw, 3) = k

Cells(rw, 4) = l

Cells(rw, 5) = m

Cells(rw, 6) = n

Cells(rw, 7) = o

rw = rw + 1

End If

If ((summ133 = 133) And (dif > 13)) Then

Worksheets("Blad2").Cells(rw, 1) = i

Worksheets("Blad2").Cells(rw, 1) = j

Worksheets("Blad2").Cells(rw, 1) = k

Worksheets("Blad2").Cells(rw, 1) = l

Worksheets("Blad2").Cells(rw, 1) = m

Worksheets("Blad2").Cells(rw, 1) = n

Worksheets("Blad2").Cells(rw, 1) = o

rw = rw + 1

End If

Next o

Next n

Next m

Next l

Next k

Next j

Next i

End Sub

 

[Herbert Seidenberg]

Each summ=98 to summ=133 has more than 65000 solutions
and needs 2 sheets.
The program shows the 65855 solutions for (summ=101
AND dif>13) on 2 sheets.
Add references to other worksheets and expand the code
for all the other conditions.
On Blad1 and Blad2, define the names of List1 and List2
as 65000 by 7 arrays, and Count1, Count2 as single cells.
The program takes 9 seconds.
Any changes in format might increase the runtime dramatically.

Option Explicit
Option Base 1

Sub combin_sv()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim o As Integer
Dim p As Long
Dim q As Long
Dim rw1 As Long
Dim rw2 As Long
Dim summ As Integer
Dim dif As Integer
Dim accum1() As Variant
Dim accum2() As Variant
ReDim accum1(65000, 15)
ReDim accum2(65000, 15)
Worksheets("Blad1").Range("List1").ClearContents
Worksheets("Blad2").Range("List2").ClearContents
rw1 = 1
rw2 = 1
p = 1
q = 1
For i = 1 To 19
For j = i + 1 To 24
For k = j + 1 To 26
For l = k + 1 To 30
For m = l + 1 To 33
For n = m + 1 To 34
For o = n + 1 To 35
summ = i + j + k + l + m + n + o
dif = o - i
If summ = 101 And dif > 13 And rw1 < 65000 Then
accum1(rw1, 1) = i
accum1(rw1, 2) = j
accum1(rw1, 3) = k
accum1(rw1, 4) = l
accum1(rw1, 5) = m
accum1(rw1, 6) = n
accum1(rw1, 7) = o
rw1 = rw1 + 1
p = p + 1
End If

If summ = 101 And dif > 13 And rw1 >= 65000 Then
accum2(rw2, 1) = i
accum2(rw2, 2) = j
accum2(rw2, 3) = k
accum2(rw2, 4) = l
accum2(rw2, 5) = m
accum2(rw2, 6) = n
accum2(rw2, 7) = o
rw2 = rw2 + 1
q = q + 1
End If
Next o
Next n
Next m
Next l
Next k
Next j
Next i
Worksheets("Blad1").Range("List1") = accum1
Worksheets("Blad2").Range("List2") = accum2
Worksheets("Blad1").Range("Count1") = p
Worksheets("Blad2").Range("Count2") = q
End Sub

 

[Sweden]

Hallo and Thank You Mr Herbert Seidenberg!

You gave me a idea, I tried that code you wrote in the forum but it
stops because of an error. Did you test it?
Thank You for your reply, I hope you have the time check it out and if
you can write again with the write code.

Sweden

 

[Herbert Seidenberg]

The code works on my machine.
Send me your latest spreadsheet.
(e-mail address removed) remove date

 

[Sweden]

I got a "runtime error 1004" when I try to run that code.
I can use my own code in excel with out any pproblems!!!
Do you an idea what it can be?
Thanks for your reply again!

Sweden

 

[Sweden]

Can anyone help solving this problem?
This code doesn´t work, it stops with the massage "runtime error 1004"

 

[Sweden]

Hallo everybody!

Now I got the code that make it possible to run over 65500 worksheets
in excel, I meen if you want to have over 100000 combinations and
permutations for exampel and you need to continue to another worksheet
after the 65536 cells are filled, so here is the code.
You can modify it as you want!

Sub aa()
Dim i, j, k, l, m, n, o, p, rw, rw2, rw3, rw4, rw5, rw6, rw7, rw8, rw9,
rw10, rw11, rw12, rw13, rw14, rw15, rw16, rw17, rw19, rw20, rw21, rw22,
rw23, rw24, rw25, rw26, rw27, rw28, rw29, rw30, rw31, rw32, rw33, rw34,
rw35, rw36, rw37, rw38, rw39, rw40, rw41, rw42, rw43, rw44, rw45, rw46,
rw47, rw48, rw49, rw50, summe, summe1, summe2, summe3, summe4, summe5,
summe6, dif, dif1, dif2, dif3, dif4, dif5, dif6


rw = 1
rw2 = 1
rw3 = 1
rw4 = 1
rw5 = 1
rw6 = 1
rw7 = 1
rw8 = 1
rw9 = 1
rw10 = 1
rw11 = 1


For i = 1 To 19

For j = i + 1 To 24

For k = j + 1 To 26

For l = k + 1 To 30

For m = l + 1 To 33

For n = m + 1 To 34

For o = n + 1 To 35

summe1 = i + j
summe2 = j + k
summe3 = k + l
summe4 = l + m
summe5 = m + n
summe6 = n + o
summe = i + j + k + l + m + n + o

dif = o - i
dif1 = o - n
dif2 = n - m
dif3 = m - l
dif4 = l - k
dif5 = k - j
dif6 = j - i

If ((rw < 65536) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12))
Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Cells(rw, 1) = i

Cells(rw, 2) = j

Cells(rw, 3) = k

Cells(rw, 4) = l

Cells(rw, 5) = m

Cells(rw, 6) = n

Cells(rw, 7) = o

rw = rw + 1

End If
End If


If ((rw > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw2 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad2").Cells(rw2, 1) = i

Worksheets("Blad2").Cells(rw2, 2) = j

Worksheets("Blad2").Cells(rw2, 3) = k

Worksheets("Blad2").Cells(rw2, 4) = l

Worksheets("Blad2").Cells(rw2, 5) = m

Worksheets("Blad2").Cells(rw2, 6) = n

Worksheets("Blad2").Cells(rw2, 7) = o

rw2 = rw2 + 1

End If
End If

If ((rw2 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw3 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad3").Cells(rw3, 1) = i

Worksheets("Blad3").Cells(rw3, 2) = j

Worksheets("Blad3").Cells(rw3, 3) = k

Worksheets("Blad3").Cells(rw3, 4) = l

Worksheets("Blad3").Cells(rw3, 5) = m

Worksheets("Blad3").Cells(rw3, 6) = n

Worksheets("Blad3").Cells(rw3, 7) = o

rw3 = rw3 + 1

End If
End If

If ((rw3 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw4 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad4").Cells(rw4, 1) = i

Worksheets("Blad4").Cells(rw4, 2) = j

Worksheets("Blad4").Cells(rw4, 3) = k

Worksheets("Blad4").Cells(rw4, 4) = l

Worksheets("Blad4").Cells(rw4, 5) = m

Worksheets("Blad4").Cells(rw4, 6) = n

Worksheets("Blad4").Cells(rw4, 7) = o

rw4 = rw4 + 1

End If
End If


If ((rw4 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw5 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad5").Cells(rw5, 1) = i

Worksheets("Blad5").Cells(rw5, 2) = j

Worksheets("Blad5").Cells(rw5, 3) = k

Worksheets("Blad5").Cells(rw5, 4) = l

Worksheets("Blad5").Cells(rw5, 5) = m

Worksheets("Blad5").Cells(rw5, 6) = n

Worksheets("Blad5").Cells(rw5, 7) = o

rw5 = rw5 + 1

End If
End If

If ((rw5 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw6 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad6").Cells(rw6, 1) = i

Worksheets("Blad6").Cells(rw6, 2) = j

Worksheets("Blad6").Cells(rw6, 3) = k

Worksheets("Blad6").Cells(rw6, 4) = l

Worksheets("Blad6").Cells(rw6, 5) = m

Worksheets("Blad6").Cells(rw6, 6) = n

Worksheets("Blad6").Cells(rw6, 7) = o

rw6 = rw6 + 1

End If
End If

If ((rw6 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw7 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad7").Cells(rw7, 1) = i

Worksheets("Blad7").Cells(rw7, 2) = j

Worksheets("Blad7").Cells(rw7, 3) = k

Worksheets("Blad7").Cells(rw7, 4) = l

Worksheets("Blad7").Cells(rw7, 5) = m

Worksheets("Blad7").Cells(rw7, 6) = n

Worksheets("Blad7").Cells(rw7, 7) = o

rw7 = rw7 + 1

End If
End If


If ((rw7 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw8 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad8").Cells(rw8, 1) = i

Worksheets("Blad8").Cells(rw8, 2) = j

Worksheets("Blad8").Cells(rw8, 3) = k

Worksheets("Blad8").Cells(rw8, 4) = l

Worksheets("Blad8").Cells(rw8, 5) = m

Worksheets("Blad8").Cells(rw8, 6) = n

Worksheets("Blad8").Cells(rw8, 7) = o

rw8 = rw8 + 1

End If
End If

If ((rw8 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw9 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad9").Cells(rw9, 1) = i

Worksheets("Blad9").Cells(rw9, 2) = j

Worksheets("Blad9").Cells(rw9, 3) = k

Worksheets("Blad9").Cells(rw9, 4) = l

Worksheets("Blad9").Cells(rw9, 5) = m

Worksheets("Blad9").Cells(rw9, 6) = n

Worksheets("Blad9").Cells(rw9, 7) = o

rw9 = rw9 + 1

End If
End If

If ((rw9 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw10 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad10").Cells(rw10, 1) = i

Worksheets("Blad10").Cells(rw10, 2) = j

Worksheets("Blad10").Cells(rw10, 3) = k

Worksheets("Blad10").Cells(rw10, 4) = l

Worksheets("Blad10").Cells(rw10, 5) = m

Worksheets("Blad10").Cells(rw10, 6) = n

Worksheets("Blad10").Cells(rw10, 7) = o

rw10 = rw10 + 1

End If
End If


If ((rw10 > 65535) And (summe1 > 2) And (summe1 < 42) And (summe2 > 4)
And (summe2 < 51) And (summe3 > 7) And (summe3 < 57) And (summe4 > 12)
And (summe4 < 64) And (summe5 > 20) And (summe5 < 68) And (summe6 > 32)
And (summe6 < 70) And (summe > 51) And (summe < 189) And (dif > 12) And
(rw11 < 65536)) Then
If ((dif1 < 3) Or (dif2 < 3) Or (dif3 < 3) Or (dif4 < 3) Or (dif5 < 3)
Or (dif6 < 3)) Then


Worksheets("Blad11").Cells(rw11, 1) = i

Worksheets("Blad11").Cells(rw11, 2) = j

Worksheets("Blad11").Cells(rw11, 3) = k

Worksheets("Blad11").Cells(rw11, 4) = l

Worksheets("Blad11").Cells(rw11, 5) = m

Worksheets("Blad11").Cells(rw11, 6) = n

Worksheets("Blad11").Cells(rw11, 7) = o

rw11 = rw11 + 1

End If
End If

Next o

Next n

Next m

Next l

Next k

Next j

Next i

End Sub