vba code to get all combinations and permutations IF  they equal a cells
Results 1 to 7 of 7

Thread: vba code to get all combinations and permutations IF they equal a cells

  1. #1
    Board Regular
    Join Date
    Jan 2011
    Location
    orlando
    Posts
    358
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default vba code to get all combinations and permutations IF they equal a cells

    Hello folks
    I have been trying to work around this code, I need some hands on here, Please.
    I am trying to generate all possible combinations and permutations possible from the set of numbers from 0 to 9 taken four at a time BUT display ONLY the one’s that match the conditions.
    The condition that I tried is to have control on odd and even numbers per row and the sum.
    The odd and even in this case is only five possible outcomes :
    Code:
    odds even
    0 4
    1 3
    2 2
    3 1
    4 0
    And the total sum will be from 0 to 36, the maximum permutation is 9-9-9-9 so of course 36 is the maximum sum
    Also I would like to avoid this two lines

    Set rRng = Range("A1", Range("A1").End(xlDown))
    rRng.Select: p = 4

    because I already know the set of number, and is always 4, but I don’t know how to do it.
    The display could start at ("D2")
    Thank you.
    Code:
    Option Explicit
    Public sumArr As Long, oddNo As Long, evenNo As Long, oddNoReq As Long, lastRow As Long, _
    evenNoReq As Long, minSumValue As Long, maxSumValue As Long, lRow As Long, testRow As Long, minMaxRn As Long
    Sub Combinations()
          oddNoReq = Range("B27"): evenNoReq = Range("B26")
          minSumValue = Range("B29"): maxSumValue = Range("B30")
          Dim rRng As Range, p As Integer
          Dim vElements, vresult As Variant
                   lRow = 1
                   testRow = 1
                   Set rRng = Range("A1", Range("A1").End(xlDown))
                   rRng.Select: p = 4
                   vElements = Application.Index(Application.Transpose(rRng), 1, 0)
                   ReDim vresult(1 To p): Columns("C").Resize(, p + 12).Clear
                   Call CombinationsNP(vElements, p, vresult, lRow, 1, 1)
          End Sub
          Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
          Dim i As Integer, k As Integer
                   For i = iElement To UBound(vElements)
                            vresult(iIndex) = vElements(i)
                                     If iIndex = p Then
                                     For k = LBound(vresult) To UBound(vresult)
                                     If vresult(k) Mod 2 <> 0 Then oddNo = oddNo + 1
                                     If vresult(k) Mod 2 = 0 Then evenNo = evenNo + 1
                                     sumArr = sumArr + vresult(k)
                   Next k
                            If oddNo = oddNoReq And evenNo = evenNoReq _
                                     And sumArr >= minSumValue _
                                     And sumArr <= maxSumValue Then
                                     lRow = lRow + 1
                                     Range("S" & lRow) = sumArr
                                     End If
                                     testRow = testRow + 1
                                     Range("k" & testRow).Resize(, p) = vresult
                                     End If
                                     If iIndex <> p Then
                                     Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
                            End If
          
          Next i
    End Sub
    Thank you for taking time to read this.

  2. #2
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,299
    Post Thanks / Like
    Mentioned
    41 Post(s)
    Tagged
    5 Thread(s)

    Default Re: vba code to get all combinations and permutations IF they equal a cells

    Try changing this line:

    Code:
    Call CombinationsNP(vElements, p, vresult, lRow, 1, 1)
    to

    Code:
    Call CombinationsNP(Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9), 4, vresult, lRow, 1, 1)
    Here's an alternate version I wrote up with every parameter being passed in the initial CALL:

    Code:
    Public MyDict
    
    Sub CallPermute()
    
        Set MyDict = CreateObject("Scripting.Dictionary")
        Call Permute("0123456789", 0, 36, 0, 4, 0, "'", 4, 0, 0)
        Range("D:D").ClearContents
        Range("D2").Resize(MyDict.Count).Value = WorksheetFunction.Transpose(MyDict.keys)
        
    End Sub
    
    Sub Permute(ByRef Vals As String, ByRef Pmin As Long, ByRef Pmax As Long, _
                ByVal Psum As Long, ByRef Evens As Long, ByVal Esum As Long, _
                ByVal Rstr As String, ByRef MaxD As Long, ByVal Depth As Long, ByVal Loc As Long)
    Dim i As Long, w As Long
                
        If Depth = MaxD Then
            If Psum >= Pmin And Psum <= Pmax And Esum = Evens Then MyDict.Add Rstr, 1
            Exit Sub
        End If
        
        For i = Loc + 1 To Len(Vals)
            w = Mid(Vals, i, 1)
            Call Permute(Vals, Pmin, Pmax, Psum + w, Evens, Esum + IIf(w Mod 2 = 0, 1, 0), Rstr & w, MaxD, Depth + 1, i)
        Next i
                
    End Sub
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  3. #3
    Board Regular
    Join Date
    Jan 2011
    Location
    orlando
    Posts
    358
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: vba code to get all combinations and permutations IF they equal a cells

    Eric W

    MrExcel MVP Thank You, So much.
    Sir I replace the line you said ►
    Call CombinationsNP(Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9), 4, vresult, lRow, 1, 1)◄ I have to change also iRow, then work, but not in the way I was expected. the results derivate from this code are concatenated on D. The part I don't get it is the permutation formula give me 5024 possible outcome, plus combination 240 something like that, but just using common sence, if I want to use the numbers from 0 to 9 in four sets obviously the code must start on ≡ 0,0,0,0 and go all the way up to 9,9,9,9 ≡ so here there are more than 5,040 possible rows.
    The results I expect are more or less like this •

    Code:
    
    
    Code:
    C D E F
    0 0 0 0
    0 0 0 1
    0 0 1 0
    UNTIL
    9 9 9 9

    and eliminate my constrains.
    Thank you Again for your time and kindness


  4. #4
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,299
    Post Thanks / Like
    Mentioned
    41 Post(s)
    Tagged
    5 Thread(s)

    Default Re: vba code to get all combinations and permutations IF they equal a cells

    It's a little hard to debug your code, since it relies on reading data from the worksheet, which you have not provided. However, I don't know how I missed the fact that you want to allow duplicate values. In my macro, change this line:

    Code:
    For i = Loc + 1 To Len(Vals)
    to

    Code:
    For i = 1 To Len(Vals)
    and you should get the output you want.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  5. #5
    Board Regular
    Join Date
    Jan 2011
    Location
    orlando
    Posts
    358
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: vba code to get all combinations and permutations IF they equal a cells

    Thanks Eric W
    The code don't have to read anything from the worksheet, it is just to populate the four columns, I will try your lines. and I really accept any code all I want is to see the result under my control statements. Thank you again for your time

  6. #6
    MrExcel MVP shg's Avatar
    Join Date
    May 2008
    Location
    The Great State of Texas
    Posts
    21,588
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    13 Thread(s)

    Default Re: vba code to get all combinations and permutations IF they equal a cells

    You want a list of numbers 0000 thru 9999 where each digit has the same parity (odd/even)?

    Enter 000 in a cell as text, drag down 10000 rows, and add a formula:

    A
    B
    C
    1
    Num
    All Odd/Even
    2
    0000
    TRUE
    B2: =OR(SUM(MOD(MID(A2, {1,2,3,4}, 1), 2)) = {0,4})
    3
    0001
    FALSE
    4
    0002
    TRUE
    5
    0003
    FALSE
    6
    0004
    TRUE
    7
    0005
    FALSE
    8
    0006
    TRUE
    9
    0007
    FALSE
    10
    0008
    TRUE
    11
    0009
    FALSE
    12
    0010
    FALSE


    Filter col B on True to see those that are:

    A
    B
    1
    Num
    All Odd/Even
    2
    0000
    TRUE
    4
    0002
    TRUE
    6
    0004
    TRUE
    8
    0006
    TRUE
    10
    0008
    TRUE
    22
    0020
    TRUE
    24
    0022
    TRUE
    26
    0024
    TRUE

  7. #7
    Board Regular
    Join Date
    Jan 2011
    Location
    orlando
    Posts
    358
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: vba code to get all combinations and permutations IF they equal a cells

    Shg. Thanks a lot!
    You want a list of numbers 0000 thru 9999 where each digit has the same parity (odd/even)?
    No, Sir. I think the best way to describe what I try to do is to say Number Generator with Constraints to Cell Values To Fit My Specific Needs.
    It is not alway the same parity; I want to be able to display different parity, and be able to sum the numbers by row, reason why each number are in different column. ("My Journey here is really about VBA")..
    I appreciate the time you spent.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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