Macro Need

[ytayta555]

A good day !

Please very much to provide me this kind of macro which
provide me the next type of combination ( I don't know if
what I need so strong is a combination or a permutation) :

here is an simplified example :

1|1|1|1|0|0|0
1|1|1|0|1|0|0
1|1|1|0|0|1|0
1|1|1|0|0|0|1
1|1|0|1|1|0|0
1|1|0|1|0|1|0
1|1|0|1|0|0|1
1|1|0|0|1|1|0
1|1|0|0|1|0|1
1|1|0|0|0|1|1
1|0|1|1|1|0|0
1|0|1|1|0|1|0
1|0|1|1|0|0|1
1|0|1|0|1|1|0
1|0|1|0|1|0|1
1|0|1|0|0|1|1
1|0|0|1|1|1|0
1|0|0|1|1|0|1
1|0|0|1|0|1|1
1|0|0|0|1|1|1
0|1|1|1|1|0|0
0|1|1|1|0|1|0
0|1|1|1|0|0|1
0|1|1|0|1|1|0
0|1|1|0|1|0|1
0|1|1|0|0|1|1
0|1|0|1|1|1|0
0|1|0|1|1|0|1
0|1|0|1|0|1|1
0|1|0|0|1|1|1
0|0|1|1|1|1|0
0|0|1|1|1|0|1
0|0|1|1|0|1|1
0|0|1|0|1|1|1
0|0|0|1|1|1|1

This kind of combination/permutation I have need , but with first 15
numbers to be 1
and the next 30 numbers to be 0 , totally numbers 45 :
111111111111111000000000000000000000000000000

for more ideas , please read and here :
http://groups.google.ro/group/micro...amming/browse_thread/thread/c084ca40126d637c?
, really , it's last my big problem ..

Thanks to all

 

[ytayta555]

( http://groups.google.ro/group/microsoft.public.excel.programming/brow...
......in Jim Skrydlak macro it is very well to be and with 30 totally
numbers ,
first 15 of 1 and the other 15 to be 0 ..... )

 

[Dave D-C]

, really , it's last my big problem ..
This works for 4 and 4.
I can't wait around to test 15 and 30.
And these are permutations.
11110000 and 11101000 are the same combination.
(As I understand it)

Option Explicit
Const kOnes = 4, kZeros = 4
Dim zArray%(kOnes + kZeros), zRow&

Sub Main()
zRow = 0
Call Sub1(kOnes, kZeros)
End Sub

Sub Sub1(pOnes%, pZeros%)
Dim iCol%
If pOnes = 0 And pZeros = 0 Then
zRow = zRow + 1
For iCol = 1 To kOnes + kZeros
Cells(zRow, iCol) = zArray(iCol)
Next iCol
DoEvents ' to view progress
Exit Sub
End If
If pOnes > 0 Then
zArray(kOnes + kZeros + 1 - pOnes - pZeros) = 1
Call Sub1(pOnes - 1, pZeros)
End If
If pZeros > 0 Then
zArray(kOnes + kZeros + 1 - pOnes - pZeros) = 0
Call Sub1(pOnes, pZeros - 1)
End If
End Sub ' Dave D-C

 

[ytayta555]

This works for 4 and 4.

Ow , my God , Dave , you're incredible !
YOU ARE INCREDIBLE , and nothing more or less !
I gived up to hope that this year I 'll resolve this problem , but ,
sometimes , I feel like that I live in an irreal world ;
After a hard work , to get the solution in so easy way , that's
what can feel somebody !

can't wait around to test 15 and 30.

I changed Const kOnes = 4, kZeros = 4 with
Const kOnes = 15, kZeros = 30 , and it work PERFECT .

Only one thing I'd like to know , and this thing only if it is
possible ,
how must look the code, after the last row ,,row > 65536,, is
filled (I use
Excel 2003 ) , to to continue the combination in the next sheet ,
(supposing
I have 100 sheets in workbook ) ?

What can I say more ? You're incredible and it's enough

 

[Dave D-C]

Ow , my God , Dave , you're incredible !
[etc.]

You certainly made my day! You're welcome.

Only one thing I'd like to know, and this thing only if it is
possible, how must look the code, after the last row
is filled (>65536, I use Excel 2003 ) , to to continue
the combination in the next sheet, ..

Replace
zRow = zRow + 1
with
zRow = zRow + 1
If zRow > 65536 Then
zRow = 1
ActiveWorkbook.Sheets.Add
End If

I guess to view progress, you need to replace
DoEvents ' to view progress
with
If zRow = 1 Then ActiveSheet.Columns.AutoFit
Cells(zRow, 1).Select
DoEvents ' to view progress

Best to you, Dave D-C

 

[Dave D-C]

I guess to view progress, you need to
If zRow = 1 Then ActiveSheet.Columns.AutoFit
Cells(zRow, 1).Select
DoEvents ' to view progress

Since there are SO MANY permutations and
displaying every row slows it up so much,
it would be better to just display every 1000th row:

Option Explicit
Const kOnes = 15, kZeros = 30
Dim zArray%(kOnes + kZeros), zRow&

Sub Main()
zRow = 0
Call Sub1(kOnes, kZeros)
End Sub

Sub Sub1(pOnes%, pZeros%)
Dim iCol%
If pOnes = 0 And pZeros = 0 Then
zRow = zRow + 1
If zRow > 65536 Then
zRow = 1
ActiveWorkbook.Sheets.Add
End If
For iCol = 1 To kOnes + kZeros
Cells(zRow, iCol) = zArray(iCol)
Next iCol
If zRow = 1 Then ActiveSheet.Columns.AutoFit
If (zRow < 1000) Or _
(zRow Mod 1000 = 0) Then
Cells(zRow, 1).Select
DoEvents ' to view progress
End If
Exit Sub
End If
If pOnes > 0 Then
zArray(kOnes + kZeros + 1 - pOnes - pZeros) = 1
Call Sub1(pOnes - 1, pZeros)
End If
If pZeros > 0 Then
zArray(kOnes + kZeros + 1 - pOnes - pZeros) = 0
Call Sub1(pOnes, pZeros - 1)
End If
End Sub ' Dave D-C

 

[ytayta555]

Perfection !

If I made you your DAY , you made me my YEAR !

Is possible and to help and the physical memory of resource sistem ,
if Sheets > 5 [(for example) I mean after 5 sheets in a wbook are
filled]
then ActiveWorkbook. Close Savechanges = True ,
then Add a new workbook (or open another) ,and so on through 5
workbooks ?

It's a rare time for me ..
Thank you that you provide me it !