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

#### montecarlo2012

##### Well-known Member
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:
``````[TABLE="width: 128"]
<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]odds [/TD]
[TD="class: xl63, width: 64"]even[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]4[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]1[/TD]
[TD="class: xl64, align: right"]3[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]2[/TD]
[TD="class: xl64, align: right"]2[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]3[/TD]
[TD="class: xl64, align: right"]1[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]4[/TD]
[TD="class: xl64, align: right"]0[/TD]
[/TR]
</tbody>[/TABLE]``````
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.

### Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

#### Eric W

##### MrExcel MVP
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``````

#### montecarlo2012

##### Well-known Member

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:
``````[/COLOR][TABLE="width: 256"]
<colgroup><col width="64" span="4" style="width:48pt"> </colgroup><tbody>[TR]
[TD="class: xl63, width: 64"]C[/TD]
[TD="class: xl63, width: 64"]D[/TD]
[TD="class: xl63, width: 64"]E[/TD]
[TD="class: xl63, width: 64"]F[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]1[/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]0[/TD]
[TD="class: xl64, align: right"]1[/TD]
[TD="class: xl64, align: right"]0[/TD]
[/TR]
[TR]
[TD="class: xl64"] [/TD]
[TD="class: xl64"]UNTIL[/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[/TR]
[TR]
[TD="class: xl64, align: right"]9[/TD]
[TD="class: xl64, align: right"]9[/TD]
[TD="class: xl64, align: right"]9[/TD]
[TD="class: xl64, align: right"]9[/TD]
[/TR]
[TR]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[TD="class: xl64"] [/TD]
[/TR]
</tbody>[/TABLE]
[COLOR=#222222]``````
and eliminate my constrains.
Thank you Again for your time and kindness

[h=1][/h]

#### Eric W

##### MrExcel MVP
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.

#### montecarlo2012

##### Well-known Member
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

#### shg

##### MrExcel MVP
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​

#### montecarlo2012

##### Well-known Member
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.

1,102,624
Messages
5,487,931
Members
407,615
Latest member
Bruce919

### This Week's Hot Topics

• Timer in VBA - Stop, Start, Pause and Reset
[CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
• how to updates multiple rows in muliselect listbox
Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
• Delete Row from Table
I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
• Assigning to a variable
I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
• Way to verify information
Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
• Active Cell Address – Inactive Sheet
How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...