So, the idea is the following – imagine that you have an NxN range, which should be filled out with consecutive numbers. Thus, if the range is 6×6, you start filling the numbers normally and once you reach the 6. column you start going down. Once you reach the 6. row, you start going to the left and after reaching the first column, you start going up. Once you reach the 2. row you start going right and you repeat this movements, until the range is filled out. At the end you get something like this:
Or even like this, if the range is 12 x 12:
How can you do it? This is what I have done. My Main sub looks like this:
|
1 2 3 4 5 6 7 8 9 |
Sub Main() Cells.Clear size = 12 SetMatrixStars MakeMatrix Cells.Columns.AutoFit End Sub |
In this sub, I am having two other subs – SetMatrixStars() and MakeMatrix(). Both these subs are actually drawing in Excel – the first one sets the stars, which are used as borders and the second one actually writes the numbers. The border stars are simply a loop, which writes the stars:
|
1 2 3 4 5 6 7 8 9 10 |
Sub SetMatrixStars() Dim i As Long For i = 1 To size Cells(size + 1, i) = "*" Cells(i, size + 1) = "*" Next i Cells(size + 1, size + 1) = "*" End Sub |
The MakeMatrix() is a sub, which actually writes the matrix – it writes to the next cell, checks whether it is not the last one and writes into it:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
Sub MakeMatrix() Dim currentCell As Range: Set currentCell = Cells(1, 1) currentMove = Right Dim i As Long Do While True i = i + 1 currentCell = i If IsLast(currentCell) Then Exit Do Set currentCell = nextCell(currentCell) Loop End Sub |
The check whether the cell is not the last one is pretty trivial – check the 4 offset cells for values and return TRUE, if they are filled out. Of course, the case in which the input values are 1 and 2 are separated from all the other cases:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Function IsLast(currentCell As Range) As Boolean If size = 1 Then IsLast = True Exit Function End If If currentCell.Row = 1 Or currentCell.Column = 1 Then If size = 2 And currentCell = 4 Then IsLast = True Else IsLast = False End If Exit Function End If IsLast = Not IsEmpty(currentCell.Offset(1, 0)) _ And Not IsEmpty(currentCell.Offset(-1, 0)) _ And Not IsEmpty(currentCell.Offset(0, -1)) _ And Not IsEmpty(currentCell.Offset(0, 1)) End Function |
The NextCell function is a bit trivial, with Select Case and Ifs:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
Public Function nextCell(currentCell As Range) As Range Select Case currentMove Case Direction.Right If IsEmpty(currentCell.Offset(, 1)) Then Set nextCell = currentCell.Offset(, 1) Else Set nextCell = currentCell.Offset(1) currentMove = Direction.Down End If Case Direction.Down If IsEmpty(currentCell.Offset(1)) Then Set nextCell = currentCell.Offset(1) Else Set nextCell = currentCell.Offset(, -1) currentMove = Direction.Left End If Case Direction.Left If currentCell.Column = 1 Then Set nextCell = currentCell.Offset(-1) currentMove = Direction.Up Else If IsEmpty(currentCell.Offset(, -1)) Then Set nextCell = currentCell.Offset(, -1) Else Set nextCell = currentCell.Offset(-1) currentMove = Direction.Up End If End If Case Direction.Up If IsEmpty(currentCell.Offset(-1)) Then Set nextCell = currentCell.Offset(-1) Else Set nextCell = currentCell.Offset(0, 1) currentMove = Direction.Right End If End Select End Function |
At the end I have decided to work a bit “dirty”, using some public variables and enumerations:
|
1 2 3 4 5 6 7 8 9 |
Private currentMove As Direction Private size As Long Public Enum Direction Right Down Left Up End Enum |
Believe it or not, the code works! It is available in GitHub here.
Cheers!