Generate specific matrix
 

Could someone help please
I m mathematician and would solve a problem I have, generating specific
matrix for each integer n
Could someone help me design a VBA prog that, for an integer n,
generate a matrix M = [A(l,c)] with following specs:
- M must be an n columns
- A(l,c) must be smaller or equal to c for every c smaller or equal to
n
- for every l integer and c integer smaller or equal to n, the integer
[ A(l,c) minus Max{1; 2; 3; ... A(l,c-1) ] is smaller or equal to 1
- no row is repeated
Many thanks for any idea to solve the problem
jiyed M




AAanother description:
- for an integer n, the matrix will be n-column
- no row is repeated
- for an integer c smaller or equal to n, the column c is populated by every
integer smaller or equal to c
- order of rows isn't important
Many thanks for any idea to solve the problem
jiyed M



examples

For n = 2, matrix is:
1 1
1 2


For n = 3, matrix is:
1 1 1
1 1 2
1 2 1
1 2 2
1 2 3


For n = 4, matrix is:
1 1 1 1
1 1 1 2
1 1 2 1
1 1 2 2
1 1 2 3
1 2 1 1
1 2 1 2
1 2 1 3
1 2 2 1
1 2 2 2
1 2 2 3
1 2 3 1
1 2 3 2
1 2 3 3
1 2 3 4


For n = 5, matrix is :
1 1 1 1 1
1 1 1 1 2
1 1 1 2 1
1 1 1 2 2
1 1 1 2 3
1 1 2 1 1
1 1 2 1 2
1 1 2 1 3
1 1 2 2 1
1 1 2 2 2
1 1 2 2 3
1 1 2 3 1
1 1 2 3 2
1 1 2 3 3
1 1 2 3 4
1 2 1 1 1
1 2 1 1 2
1 2 1 1 3
1 2 1 2 1
1 2 1 2 2
1 2 1 2 3
1 2 1 3 1
1 2 1 3 2
1 2 1 3 3
1 2 1 3 4
1 2 2 1 1
1 2 2 1 2
1 2 2 1 3
1 2 2 2 1
1 2 2 2 2
1 2 2 2 3
1 2 2 3 1
1 2 2 3 2
1 2 2 3 3
1 2 2 3 4
1 2 3 1 1
1 2 3 1 2
1 2 3 1 3
1 2 3 1 4
1 2 3 2 1
1 2 3 2 2
1 2 3 2 3
1 2 3 2 4
1 2 3 3 1
1 2 3 3 2
1 2 3 3 3
1 2 3 3 4
1 2 3 4 1
1 2 3 4 2
1 2 3 4 3
1 2 3 4 4
1 2 3 4 5

Many thanks in advance to help

--
mathematitien

Generate specific matrix
 

It would be helpful if you posted a couple of examples to show exactly what
matrix you would want for a few different n values.

Bernie

"jiyed, m" wrote in message
...
Could someone help please
I m mathematician and would solve a problem I have, generating specific
matrix for each integer n
Could someone help me design a VBA prog that, for an integer n,
generate a matrix M = [A(l,c)] with following specs:
- M must be an n columns
- A(l,c) must be smaller or equal to c for every c smaller or equal to
n
- for every l integer and c integer smaller or equal to n, the integer
[ A(l,c) minus Max{1; 2; 3; ... A(l,c-1) ] is smaller or equal to 1
- no row is repeated
Many thanks for any idea to solve the problem
jiyed M




AAanother description:
- for an integer n, the matrix will be n-column
- no row is repeated
- for an integer c smaller or equal to n, the column c is populated by
every
integer smaller or equal to c
- order of rows isn't important
Many thanks for any idea to solve the problem
jiyed M



examples

For n = 2, matrix is:
1 1
1 2


For n = 3, matrix is:
1 1 1
1 1 2
1 2 1
1 2 2
1 2 3


For n = 4, matrix is:
1 1 1 1
1 1 1 2
1 1 2 1
1 1 2 2
1 1 2 3
1 2 1 1
1 2 1 2
1 2 1 3
1 2 2 1
1 2 2 2
1 2 2 3
1 2 3 1
1 2 3 2
1 2 3 3
1 2 3 4


For n = 5, matrix is :
1 1 1 1 1
1 1 1 1 2
1 1 1 2 1
1 1 1 2 2
1 1 1 2 3
1 1 2 1 1
1 1 2 1 2
1 1 2 1 3
1 1 2 2 1
1 1 2 2 2
1 1 2 2 3
1 1 2 3 1
1 1 2 3 2
1 1 2 3 3
1 1 2 3 4
1 2 1 1 1
1 2 1 1 2
1 2 1 1 3
1 2 1 2 1
1 2 1 2 2
1 2 1 2 3
1 2 1 3 1
1 2 1 3 2
1 2 1 3 3
1 2 1 3 4
1 2 2 1 1
1 2 2 1 2
1 2 2 1 3
1 2 2 2 1
1 2 2 2 2
1 2 2 2 3
1 2 2 3 1
1 2 2 3 2
1 2 2 3 3
1 2 2 3 4
1 2 3 1 1
1 2 3 1 2
1 2 3 1 3
1 2 3 1 4
1 2 3 2 1
1 2 3 2 2
1 2 3 2 3
1 2 3 2 4
1 2 3 3 1
1 2 3 3 2
1 2 3 3 3
1 2 3 3 4
1 2 3 4 1
1 2 3 4 2
1 2 3 4 3
1 2 3 4 4
1 2 3 4 5

Many thanks in advance to help

--
mathematitien

Generate specific matrix
 

many thanks bernie for interest
examples:
For n = 2, matrix is:
1 1
1 2


For n = 3, matrix is:
1 1 1
1 1 2
1 2 1
1 2 2
1 2 3


For n = 4, matrix is:
1 1 1 1
1 1 1 2
1 1 2 1
1 1 2 2
1 1 2 3
1 2 1 1
1 2 1 2
1 2 1 3
1 2 2 1
1 2 2 2
1 2 2 3
1 2 3 1
1 2 3 2
1 2 3 3
1 2 3 4


For n = 5, matrix is :
1 1 1 1 1
1 1 1 1 2
1 1 1 2 1
1 1 1 2 2
1 1 1 2 3
1 1 2 1 1
1 1 2 1 2
1 1 2 1 3
1 1 2 2 1
1 1 2 2 2
1 1 2 2 3
1 1 2 3 1
1 1 2 3 2
1 1 2 3 3
1 1 2 3 4
1 2 1 1 1
1 2 1 1 2
1 2 1 1 3
1 2 1 2 1
1 2 1 2 2
1 2 1 2 3
1 2 1 3 1
1 2 1 3 2
1 2 1 3 3
1 2 1 3 4
1 2 2 1 1
1 2 2 1 2
1 2 2 1 3
1 2 2 2 1
1 2 2 2 2
1 2 2 2 3
1 2 2 3 1
1 2 2 3 2
1 2 2 3 3
1 2 2 3 4
1 2 3 1 1
1 2 3 1 2
1 2 3 1 3
1 2 3 1 4
1 2 3 2 1
1 2 3 2 2
1 2 3 2 3
1 2 3 2 4
1 2 3 3 1
1 2 3 3 2
1 2 3 3 3
1 2 3 3 4
1 2 3 4 1
1 2 3 4 2
1 2 3 4 3
1 2 3 4 4
1 2 3 4 5

Generate specific matrix
 

using n=5, we generated 120 rows of data.
You only selected 52
we are not so sure of reference to A(l,c) as in requirements 2 and 3 please


"jiyed, m" wrote:

Could someone help please
I m mathematician and would solve a problem I have, generating specific
matrix for each integer n
Could someone help me design a VBA prog that, for an integer n,
generate a matrix M = [A(l,c)] with following specs:
- M must be an n columns
- A(l,c) must be smaller or equal to c for every c smaller or equal to
n
- for every l integer and c integer smaller or equal to n, the integer
[ A(l,c) minus Max{1; 2; 3; ... A(l,c-1) ] is smaller or equal to 1
- no row is repeated
Many thanks for any idea to solve the problem
jiyed M




AAanother description:
- for an integer n, the matrix will be n-column
- no row is repeated
- for an integer c smaller or equal to n, the column c is populated by every
integer smaller or equal to c
- order of rows isn't important
Many thanks for any idea to solve the problem
jiyed M



examples

For n = 2, matrix is:
1 1
1 2


For n = 3, matrix is:
1 1 1
1 1 2
1 2 1
1 2 2
1 2 3


For n = 4, matrix is:
1 1 1 1
1 1 1 2
1 1 2 1
1 1 2 2
1 1 2 3
1 2 1 1
1 2 1 2
1 2 1 3
1 2 2 1
1 2 2 2
1 2 2 3
1 2 3 1
1 2 3 2
1 2 3 3
1 2 3 4


For n = 5, matrix is :
1 1 1 1 1
1 1 1 1 2
1 1 1 2 1
1 1 1 2 2
1 1 1 2 3
1 1 2 1 1
1 1 2 1 2
1 1 2 1 3
1 1 2 2 1
1 1 2 2 2
1 1 2 2 3
1 1 2 3 1
1 1 2 3 2
1 1 2 3 3
1 1 2 3 4
1 2 1 1 1
1 2 1 1 2
1 2 1 1 3
1 2 1 2 1
1 2 1 2 2
1 2 1 2 3
1 2 1 3 1
1 2 1 3 2
1 2 1 3 3
1 2 1 3 4
1 2 2 1 1
1 2 2 1 2
1 2 2 1 3
1 2 2 2 1
1 2 2 2 2
1 2 2 2 3
1 2 2 3 1
1 2 2 3 2
1 2 2 3 3
1 2 2 3 4
1 2 3 1 1
1 2 3 1 2
1 2 3 1 3
1 2 3 1 4
1 2 3 2 1
1 2 3 2 2
1 2 3 2 3
1 2 3 2 4
1 2 3 3 1
1 2 3 3 2
1 2 3 3 3
1 2 3 3 4
1 2 3 4 1
1 2 3 4 2
1 2 3 4 3
1 2 3 4 4
1 2 3 4 5

Many thanks in advance to help

--
mathematitien

Generate specific matrix
 

many thanks for interest PY
if you filter each c column so that: each c column is populated by just all
integers equal or smaller than c you will have exactly 52 for n=5
How could i send you a sample excel file?

--
mathematitien


"PY & Associates" wrote:

using n=5, we generated 120 rows of data.
You only selected 52
we are not so sure of reference to A(l,c) as in requirements 2 and 3 please

Generate specific matrix
 

this may not help but it handle the matrix for n =2 to n = 5
you could mimic/extend the coding for n = 6, etc
maybe someone else knows how to this this better

Sub macro1()
' clear old matrix
Range("A1").Select
Selection.CurrentRegion.ClearContents
'
' Read in n value
'
n = Range("nvalue").Value
i = 0
a = 1
If n = 2 Then GoTo two
If n = 3 Then GoTo three
If n = 4 Then GoTo four
If n = 5 Then GoTo five
two:
new2i:
i = i + 1
j = 0
new2j:
j = j + 1
Cells(a, 1) = i
Cells(a, 2) = j
a = a + 1
If j < 2 And j - i < 1 Then GoTo new2j Else GoTo incr2i
incr2i:
If i < 1 Then GoTo new2i Else GoTo done
three:
new3i:
i = i + 1
k = 0
j = 0
new3j:
j = j + 1
k = 0
new3k:
k = k + 1
Cells(a, 1) = i
Cells(a, 2) = j
Cells(a, 3) = k
a = a + 1
If k < 3 And k - j < 1 Then GoTo new3k Else GoTo incr3j
incr3j:
If j < 2 And j - i < 1 Then GoTo new3j Else GoTo incr3i
incr3i:
If i < 1 Then GoTo new3i Else GoTo done
four:
new4i:
i = i + 1
k = 0
j = 0
l = 0
new4j:
j = j + 1
k = 0
l = 0
new4k:
k = k + 1
l = 0
new4l:
l = l + 1
Cells(a, 1) = i
Cells(a, 2) = j
Cells(a, 3) = k
Cells(a, 4) = l
a = a + 1
If l < n And l - k < 1 Then GoTo new4l Else GoTo incr4k
incr4k:
If k < 3 And k - j < 1 Then GoTo new4k Else GoTo incr4j
incr4j:
If j < 2 And j - i < 1 Then GoTo new4j Else GoTo incr4i
incr4i:
If i < 1 Then GoTo new4i Else GoTo done
five:
new5i:
i = i + 1
k = 0
j = 0
l = 0
new5j:
j = j + 1
k = 0
l = 0
new5k:
k = k + 1
l = 0
new5l:
l = l + 1
m = 0
new5m:
m = m + 1
Cells(a, 1) = i
Cells(a, 2) = j
Cells(a, 3) = k
Cells(a, 4) = l
Cells(a, 5) = m
a = a + 1
If m < n And m - l < 1 Then GoTo new5m Else GoTo incr5l
incr5l:
If l < n And l - k < 1 Then GoTo new5l Else GoTo incr5k
incr5k:
If k < 3 And k - j < 1 Then GoTo new5k Else GoTo incr5j
incr5j:
If j < 2 And j - i < 1 Then GoTo new5j Else GoTo incr5i
incr5i:
If i < 1 Then GoTo new5i Else GoTo done
done:
End Sub


--
duane


------------------------------------------------------------------------
duane's Profile: http://www.excelforum.com/member.php...o&userid=11624
View this thread: http://www.excelforum.com/showthread...hreadid=482653

Generate specific matrix
 

We looked at our test file again.
We have 97 rows please

Did you look at the file we sent you?
Where have we misunderstood your requirements please?

"jiyed, m" wrote:

many thanks for interest PY
if you filter each c column so that: each c column is populated by just all
integers equal or smaller than c you will have exactly 52 for n=5
How could i send you a sample excel file?

--
mathematitien


"PY & Associates" wrote:

using n=5, we generated 120 rows of data.
You only selected 52
we are not so sure of reference to A(l,c) as in requirements 2 and 3 please

Generate specific matrix
 

I posted this on the other board too.....

this may not help but it handle the matrix for n =2 to n = 5
you could mimic/extend the coding for n = 6, etc
maybe someone else knows how to handle this better

Sub macro1()
' clear old matrix
Range("A1").Select
Selection.CurrentRegion.ClearContents
'
' Read in n value
'
n = Range("nvalue").Value
i = 0
a = 1
If n = 2 Then GoTo two
If n = 3 Then GoTo three
If n = 4 Then GoTo four
If n = 5 Then GoTo five
two:
new2i:
i = i + 1
j = 0
new2j:
j = j + 1
Cells(a, 1) = i
Cells(a, 2) = j
a = a + 1
If j < 2 And j - i < 1 Then GoTo new2j Else GoTo incr2i
incr2i:
If i < 1 Then GoTo new2i Else GoTo done
three:
new3i:
i = i + 1
k = 0
j = 0
new3j:
j = j + 1
k = 0
new3k:
k = k + 1
Cells(a, 1) = i
Cells(a, 2) = j
Cells(a, 3) = k
a = a + 1
If k < 3 And k - j < 1 Then GoTo new3k Else GoTo incr3j
incr3j:
If j < 2 And j - i < 1 Then GoTo new3j Else GoTo incr3i
incr3i:
If i < 1 Then GoTo new3i Else GoTo done
four:
new4i:
i = i + 1
k = 0
j = 0
l = 0
new4j:
j = j + 1
k = 0
l = 0
new4k:
k = k + 1
l = 0
new4l:
l = l + 1
Cells(a, 1) = i
Cells(a, 2) = j
Cells(a, 3) = k
Cells(a, 4) = l
a = a + 1
If l < n And l - k < 1 Then GoTo new4l Else GoTo incr4k
incr4k:
If k < 3 And k - j < 1 Then GoTo new4k Else GoTo incr4j
incr4j:
If j < 2 And j - i < 1 Then GoTo new4j Else GoTo incr4i
incr4i:
If i < 1 Then GoTo new4i Else GoTo done
five:
new5i:
i = i + 1
k = 0
j = 0
l = 0
new5j:
j = j + 1
k = 0
l = 0
new5k:
k = k + 1
l = 0
new5l:
l = l + 1
m = 0
new5m:
m = m + 1
Cells(a, 1) = i
Cells(a, 2) = j
Cells(a, 3) = k
Cells(a, 4) = l
Cells(a, 5) = m
a = a + 1
If m < n And m - l < 1 Then GoTo new5m Else GoTo incr5l
incr5l:
If l < n And l - k < 1 Then GoTo new5l Else GoTo incr5k
incr5k:
If k < 3 And k - j < 1 Then GoTo new5k Else GoTo incr5j
incr5j:
If j < 2 And j - i < 1 Then GoTo new5j Else GoTo incr5i
incr5i:
If i < 1 Then GoTo new5i Else GoTo done
done:
End Sub

Generate specific matrix
 

sorry about that - thought i had it but found an error - guess I do not
yet understand constraints of matrix elements


--
duane


------------------------------------------------------------------------
duane's Profile: http://www.excelforum.com/member.php...o&userid=11624
View this thread: http://www.excelforum.com/showthread...hreadid=482653

Generate specific matrix
 

Sub test()
Dim a(99)
m = 4
limit = WorksheetFunction.Fact(m)

For y = 0 To limit - 1
n = m
x = y

For j = m To 1 Step -1
a(j) = x Mod n + 1

If n = 1 Then GoTo skip

x = (x - (x Mod n)) / n
n = n - 1
Next j

skip:
counter = counter + 1
MsgBox counter
MsgBox a(1) & a(2) & a(3) & a(4) & a(5)

Next y
End Sub

Generate specific matrix
 

Our modified code yields 42 rows of data;
Chu's code yields 24 rows
Meawhile, our mathematician is very quiet

=====
Sub t()
Cells.Clear
n = 5
y = 0
For i = 1 To n - 3
For j = 1 To n - 2
For k = 1 To n - 1
For l = 1 To n
y = y + 1
Cells(y, 1) = i
Cells(y, 2) = j
Cells(y, 3) = k
Cells(y, 4) = l
Next l
Next k
Next j
Next i
icol = 1
For irow = Cells(65536, 4).End(xlUp).Row To 1 Step -1
If Cells(irow, icol) Cells(irow, icol + 1) Or Cells(irow, icol
+ 1) Cells(irow, icol + 2) _
Or Cells(irow, icol + 2) Cells(irow, icol + 3) Then
Rows(irow).Delete
Next irow
End Sub

" wrote:

Sub test()
Dim a(99)
m = 4
limit = WorksheetFunction.Fact(m)

For y = 0 To limit - 1
n = m
x = y

For j = m To 1 Step -1
a(j) = x Mod n + 1

If n = 1 Then GoTo skip

x = (x - (x Mod n)) / n
n = n - 1
Next j

skip:
counter = counter + 1
MsgBox counter
MsgBox a(1) & a(2) & a(3) & a(4) & a(5)

Next y
End Sub

Generate specific matrix
 

m,

The macro below will generate - exactly - the matrices that you posted. I think that the pattern is
followed for larger n, but that is something that you can test easily enough. Simply run the macro,
and respond to the query with the size. Note that you cannot create a matrix larger than n = 11, or
you will run out of rows on the sheet.

Also note that while the macro places the values onto the spreadsheet, the code could be re-written
to either place the values into an array within VBA, or to read the cells into the array after the
matrix has been generated. The code was written to allow you to call it easily from a different
subroutine - see the test macro for details.

HTH,
Bernie
MS Excel MVP

Option Explicit

Sub test()
Dim mySize As Integer

mySize = Application.InputBox("What n do you want to do?", _
"Matrix Creation", , , , , , 1)
MakeMatrix mySize
End Sub

Sub MakeMatrix(n As Integer)
Dim i As Integer
Dim j As Integer
Dim myRow As Long
Dim myCol As Integer
Dim myCell As Range
Dim NotDone As Boolean
Dim myMax As Integer
Dim myMaxC As Integer

Set myCell = ActiveCell

'Create First 2 Rows
For myCol = 1 To n
myCell(1, myCol).Value = 1
myCell(2, myCol).Value = 1
Next myCol
myCell(2, n).Value = 2

myRow = 2
NotDone = False

For myCol = 1 To n - 1
If myCell(myRow, myCol).Value < _
myCell(myRow, myCol + 1).Value - 1 Then
NotDone = True
End If
Next myCol

While NotDone

myCell(myRow, 1).Resize(1, n).Copy myCell(myRow + 1, 1)
myRow = myRow + 1

myMax = Application.Max(myCell(myRow, 1).Resize(1, n))
myMaxC = Application.CountIf(myCell(myRow, 1).Resize(1, n), myMax)

If myMaxC = 1 And myCell(myRow, n).Value = myMax Then
For i = n - 1 To 2 Step -1
If myCell(myRow, i).Value < myCell(myRow, i + 1).Value - 1 Then
myCell(myRow, i).Value = myCell(myRow, i).Value + 1
For j = i + 1 To n
myCell(myRow, j).Value = 1
Next j
GoTo Changed:
End If

If myCell(myRow, i).Value = myCell(myRow, i - 1).Value Then
myCell(myRow, i).Value = myCell(myRow, i).Value + 1
For j = i + 1 To n
myCell(myRow, j).Value = 1
Next j
GoTo Changed:
End If
Next i
End If

If myCell(myRow, n).Value < myMax And myMaxC = 1 Then
myCell(myRow, n).Value = myCell(myRow, n).Value + 1
GoTo Changed:
End If

If myCell(myRow, n).Value < myMax Then
myCell(myRow, n).Value = myCell(myRow, n).Value + 1
GoTo Changed:
End If

If myCell(myRow, n).Value = myMax And myMaxC < 1 Then
myCell(myRow, n).Value = myCell(myRow, n).Value + 1
GoTo Changed:
End If

If myCell(myRow, n).Value = myMax And myMaxC = 1 Then
myCell(myRow, n - 1).Value = myCell(myRow, n - 1).Value + 1
myCell(myRow, n).Value = 1
GoTo Changed:
End If

Changed:

'Check Again
NotDone = False
For myCol = 1 To n - 1
If myCell(myRow, myCol).Value < _
myCell(myRow, myCol + 1).Value - 1 Then
NotDone = True
End If
Next myCol

Wend

End Sub




"jiyed, m" wrote in message
...
many thanks bernie for interest
examples:
For n = 2, matrix is:
1 1
1 2


For n = 3, matrix is:
1 1 1
1 1 2
1 2 1
1 2 2
1 2 3


For n = 4, matrix is:
1 1 1 1
1 1 1 2
1 1 2 1
1 1 2 2
1 1 2 3
1 2 1 1
1 2 1 2
1 2 1 3
1 2 2 1
1 2 2 2
1 2 2 3
1 2 3 1
1 2 3 2
1 2 3 3
1 2 3 4


For n = 5, matrix is :
1 1 1 1 1
1 1 1 1 2
1 1 1 2 1
1 1 1 2 2
1 1 1 2 3
1 1 2 1 1
1 1 2 1 2
1 1 2 1 3
1 1 2 2 1
1 1 2 2 2
1 1 2 2 3
1 1 2 3 1
1 1 2 3 2
1 1 2 3 3
1 1 2 3 4
1 2 1 1 1
1 2 1 1 2
1 2 1 1 3
1 2 1 2 1
1 2 1 2 2
1 2 1 2 3
1 2 1 3 1
1 2 1 3 2
1 2 1 3 3
1 2 1 3 4
1 2 2 1 1
1 2 2 1 2
1 2 2 1 3
1 2 2 2 1
1 2 2 2 2
1 2 2 2 3
1 2 2 3 1
1 2 2 3 2
1 2 2 3 3
1 2 2 3 4
1 2 3 1 1
1 2 3 1 2
1 2 3 1 3
1 2 3 1 4
1 2 3 2 1
1 2 3 2 2
1 2 3 2 3
1 2 3 2 4
1 2 3 3 1
1 2 3 3 2
1 2 3 3 3
1 2 3 3 4
1 2 3 4 1
1 2 3 4 2
1 2 3 4 3
1 2 3 4 4
1 2 3 4 5

Generate specific matrix
 

Thanking you for help
I tested and find it's perfectly what I wanted,
As you mentionned it can't run more than n = 11
As I have more constraints depending on other variables, I couldn't yet
normalise in a mathematical manner
many thanks again
Regards


*** Sent via Developersdex http://www.developersdex.com ***

Generate specific matrix
 

Many thanks for effort
Script below don't seem to give good result
But I think the script given by Bernie MS Excel MVP on as follow is perfect
even
unfortunatly matrix over the work sheet I must work on another constraint to
have specific combination
Many thanks Bernie
Many thanks for you all
Regards
Mjiyed


Sub test()
Dim mySize As Integer

mySize = Application.InputBox("What n do you want to do?", _
"Matrix Creation", , , , , , 1)
MakeMatrix mySize
End Sub

Sub MakeMatrix(n As Integer)
Dim i As Integer
Dim j As Integer
Dim myRow As Long
Dim myCol As Integer
Dim myCell As Range
Dim NotDone As Boolean
Dim myMax As Integer
Dim myMaxC As Integer

Set myCell = ActiveCell

'Create First 2 Rows
For myCol = 1 To n
myCell(1, myCol).Value = 1
myCell(2, myCol).Value = 1
Next myCol
myCell(2, n).Value = 2

myRow = 2
NotDone = False

For myCol = 1 To n - 1
If myCell(myRow, myCol).Value < _
myCell(myRow, myCol + 1).Value - 1 Then
NotDone = True
End If
Next myCol

While NotDone

myCell(myRow, 1).Resize(1, n).Copy myCell(myRow + 1, 1)
myRow = myRow + 1

myMax = Application.Max(myCell(myRow, 1).Resize(1, n))
myMaxC = Application.CountIf(myCell(myRow, 1).Resize(1, n), myMax)

If myMaxC = 1 And myCell(myRow, n).Value = myMax Then
For i = n - 1 To 2 Step -1
If myCell(myRow, i).Value < myCell(myRow, i + 1).Value - 1 Then
myCell(myRow, i).Value = myCell(myRow, i).Value + 1
For j = i + 1 To n
myCell(myRow, j).Value = 1
Next j
GoTo Changed:
End If

If myCell(myRow, i).Value = myCell(myRow, i - 1).Value Then
myCell(myRow, i).Value = myCell(myRow, i).Value + 1
For j = i + 1 To n
myCell(myRow, j).Value = 1
Next j
GoTo Changed:
End If
Next i
End If

If myCell(myRow, n).Value < myMax And myMaxC = 1 Then
myCell(myRow, n).Value = myCell(myRow, n).Value + 1
GoTo Changed:
End If

If myCell(myRow, n).Value < myMax Then
myCell(myRow, n).Value = myCell(myRow, n).Value + 1
GoTo Changed:
End If

If myCell(myRow, n).Value = myMax And myMaxC < 1 Then
myCell(myRow, n).Value = myCell(myRow, n).Value + 1
GoTo Changed:
End If

If myCell(myRow, n).Value = myMax And myMaxC = 1 Then
myCell(myRow, n - 1).Value = myCell(myRow, n - 1).Value + 1
myCell(myRow, n).Value = 1
GoTo Changed:
End If

Changed:

'Check Again
NotDone = False
For myCol = 1 To n - 1
If myCell(myRow, myCol).Value < _
myCell(myRow, myCol + 1).Value - 1 Then
NotDone = True
End If
Next myCol

Wend

End Sub