+ Reply to Thread
Results 1 to 7 of 7

Permutation in excel

  1. #1
    Registered User
    Join Date
    09-16-2005
    Posts
    20

    Permutation in excel

    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

  2. #2
    Herbert Seidenberg
    Guest

    Re: Permutation in excel

    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


  3. #3
    Registered User
    Join Date
    09-16-2005
    Posts
    20

    Permutation in excel

    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

  4. #4
    Herbert Seidenberg
    Guest

    Re: Permutation in excel

    The code works on my machine.
    Send me your latest spreadsheet.
    [email protected] remove date


  5. #5
    Registered User
    Join Date
    09-16-2005
    Posts
    20

    Hallo again!

    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

  6. #6
    Registered User
    Join Date
    09-16-2005
    Posts
    20

    Permutation in Excel

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

    Sweden

  7. #7
    Registered User
    Join Date
    09-16-2005
    Posts
    20

    Permutation in Excel - It Works with over 65500

    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

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1