Awesome, that is almost exactly what I am looking for! I like that I can use any number of columns in sheet 1 and I can stop the output at row 1,000,000, but is it possible to have it to put the output in separate columns and then skip 4 columns and start with the next set of permutations?
To keep it simple, I only used 2 columns of input in my example:
Here is the input for sheet 1:
| | |
| A
| B
|
1
| aa11
| 11
|
2
| 2
| c
|
3
| b
| 33
|
<tbody>
[TD="colspan: 3"]INPUT
[/TD]
</tbody>
Then I get this:
| |
| A
|
1
| aa11
|
2
| aac
|
3
| aa33
|
4
| 211
|
5
| 2c
|
6
| 233
|
7
| b11
|
8
| bc
|
9
| b33
|
<tbody>
[TD="colspan: 2"]CURRENT
[/TD]
</tbody>
How can I change the code to get this instead in sheet 2 where the permutations are broken out into individual cells and 4 columns are left in between each 1,000,000 rows of permutations like so:
| | | | | | | | | | |
| A
| B
| C
| D
| E
| F
| G
| H
| I
| J
|
1
| aa
| 11
|
|
|
|
| After Row 1,000,000 the Next permutations start here
|
|
|
|
2
| aa
| c
|
|
|
|
|
|
|
|
|
3
| aa
| 33
|
|
|
|
|
|
|
|
|
4
| 2
| 11
|
|
|
|
|
|
|
|
|
5
| 2
| c
|
|
|
|
|
|
|
|
|
6
| 2
| 33
|
|
|
|
|
|
|
|
|
7
| b
| 11
|
|
|
|
|
|
|
|
|
8
| b
| c
|
|
|
|
|
|
|
|
|
9
| B
| 33
|
|
|
|
|
|
|
|
|
<tbody>
[TD="colspan: 11"]DESIRED
[/TD]
</tbody>
Here is your code below that was used (also the words input, current, and desired are not needed, they were only used to help with this example):
Sub Permute()
Dim ix(100, 1) As Long, rc As Long, m As Long, br As Long, md As Variant, i As Long, r As Long
Dim str1 As String, r1 As Long, c1 As Long
rc = Cells(1, Columns.Count).End(xlToLeft).Column
m = 0
For i = 1 To rc
br = Cells(Rows.Count, i).End(xlUp).Row
If br > m Then m = br
ix(i, 0) = br
ix(i, 1) = 1
Next i
md = Range(Cells(1, 1), Cells(m, rc)).Value
r = 0
Incr:
str1 = ""
For i = 1 To rc
str1 = str1 & md(ix(i, 1), i)
Next i
r = r + 1
r1 = ((r - 1) Mod 1000000) + 1
c1 = Int((r - 1) / 1000000) + 1
Sheets("Sheet2").Cells(r1, c1) = str1
For i = rc To 1 Step -1
ix(i, 1) = ix(i, 1) + 1
If ix(i, 1) <= ix(i, 0) Then Exit For
ix(i, 1) = 1
Next i
If i > 0 Then GoTo Incr:
End Sub
