VBA – Fill Numbers in a Given Range
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:
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:
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:
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:
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:
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:
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!