PDA

View Full Version : Solved: VBA spiral



theriot
10-08-2010, 09:44 PM
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.

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

macropod
10-08-2010, 11:29 PM
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
10-09-2010, 07:11 AM
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
10-09-2010, 06:17 PM
Then your professor is failing to fulfill their responcibility to "teach"