Solved: VBA spiral

[theriot]

Im trying to make a spiral in excel using a vba code. I managed to get it working but i think there may be a more efficient way to go about it. If anyone has any suggestions i would appreciate it.

[VBA]Option Explicit
Sub spiral()
Dim userinput As Long
Dim n As Long
Dim i As Long
Dim j As Long
userinput = InputBox("go how far?")
n = 1
j = 0
i = 1

Do Until n > userinput
Do Until j > i
If n <= userinput Then
ActiveCell.Offset(0, 1).Select
ActiveCell = n
ActiveCell.Interior.Color = vbRed
j = j + 1
n = n + 1
Else
Exit Sub
End If
Loop
i = i + 1
j = 1
Do Until j > i
If n <= userinput Then
ActiveCell.Offset(-1, 0).Select
ActiveCell = n
ActiveCell.Interior.Color = vbYellow
j = j + 1
n = n + 1
Else
Exit Sub
End If
Loop
i = i + 1
j = 1
Do Until j > i
If n <= userinput Then
ActiveCell.Offset(0, -1).Select
ActiveCell = n
ActiveCell.Interior.Color = vbGreen
j = j + 1
n = n + 1
Else
Exit Sub
End If
Loop
i = i + 1
j = 1
Do Until j > i
If n <= userinput Then
ActiveCell.Offset(1, 0).Select
ActiveCell = n
ActiveCell.Interior.Color = vbBlue
j = j + 1
n = n + 1
Else
Exit Sub
End If
Loop
i = i + 1
j = 1

Loop
End Sub[/VBA]

[macropod]

Hi theriot,

The code could be made much more efficient by avoiding the selections:

Sub Spiral()
Dim userinput As Long, n As Long, i As Long, j As Long, rngAddr As Range
userinput = InputBox("go how far?")
n = 1: j = 0: i = 1
Set rngAddr = ActiveCell
Do Until n > userinput
  Do Until j > i
    If n <= userinput Then
      Set rngAddr = rngAddr.Offset(0, 1)
      rngAddr.Value = n
      rngAddr.Interior.Color = vbRed
      j = j + 1
      n = n + 1
    Else
      Exit Sub
    End If
  Loop
  i = i + 1
  j = 1
  Do Until j > i
    If n <= userinput Then
      Set rngAddr = rngAddr.Offset(-1, 0)
      rngAddr.Value = n
      rngAddr.Interior.Color = vbYellow
      j = j + 1
      n = n + 1
    Else
      Exit Sub
    End If
  Loop
  i = i + 1
  j = 1
  Do Until j > i
    If n <= userinput Then
      Set rngAddr = rngAddr.Offset(0, -1)
      rngAddr.Value = n
      rngAddr.Interior.Color = vbGreen
      j = j + 1
      n = n + 1
    Else
      Exit Sub
    End If
  Loop
  i = i + 1
  j = 1
  Do Until j > i
    If n <= userinput Then
      Set rngAddr = rngAddr.Offset(1, 0)
      rngAddr.Value = n
      rngAddr.Interior.Color = vbBlue
      j = j + 1
      n = n + 1
    Else
      Exit Sub
    End If
  Loop
  i = i + 1
  j = 1
Loop
Set rngAddr = Nothing
End Sub

Note: You also need some error-checking in case the active cell doesn't allow enough room for the spiral range to grow.

[theriot]

Thank you. That was helpful. Our professor who teaches us this doesn't like to help us with our code or explain why anything is done.

[Aussiebear]

Then your professor is failing to fulfill their responcibility to "teach"