VBA Array Problem, not for the faint of heart

[robboll]

Given: A 5 x 5 matrix:


| 1 2 3 4 5
| 6 7 8 9 10
y 11 12 13 14 15
| 16 17 18 19 20
| 21 22 23 24 25
----------------------- x ----------------

Where if you select 13, the array function should return
13, 8, 9, 14, 19, 18, 17, 12, 7, 2, 3, 4, 5, 10, 15, 20, 25 . . .
note the spiral pattern clockwise around number 13.


Pseudocoding, using dbase I would use something like:

arrayname[x,y-1] && this would pull the number above 12 (7)
arrayname[x+1,y-1] && this would pull the number above and one
right
&& of 12 (8)
arrayname[x+1,y] && this would pull the number directly right

of 12 (13)

Any ideas of how to do this using MS Access? Some folks in another
newsgroup suggested Excel. I would like to stick to MS Access
functionality.

Thanks,

Rbollinger

 

[Dave]

sounds like a homework problem... hard code the sequence and you are bound
to fail. start by nesting a couple for/next loops and generalize the
technique so when tomorrows homework calls for a 9x9 array and picking any
cell to start you don't have to do it all over again.

 

[robboll]

Not a homework problem. Just trying to see if such an array routine is
possible using MS Access. Definately possible using xbase.

 

[Tushar Mehta]

While I don't know the dbase syntax, from what you have shared it would
appear that if you know how to do it in dbase you know how to do it in
vb. Indexing an array though is somewhat different. In vb (i,j)
refers to (row,column) whereas from your example dbase uses (column,
row).

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

 

[RB Smissaert]

This will do it for in sheet in Excel.
It will be no different for an array, just make a small adjustment if it is
an 0-based arrray.


Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub CircleAway(lRow As Long, lColumn As Long)

'loop counter
Dim i As Long

'to keep track of column and row
Dim rSel As Long
Dim cSel As Long

Dim lCircleCount As Long
Dim lIncrement As Long

On Error GoTo ERROROUT

'starting cell
rSel = lRow
cSel = lColumn

'starting cell
SelectCell rSel, cSel

Do 'circle loop
lCircleCount = lCircleCount + 1
lIncrement = 2 * lCircleCount - 1

'one up to start with
rSel = rSel - 1
SelectCell rSel, cSel

For i = 1 To lIncrement 'going right loop
cSel = cSel + 1
SelectCell rSel, cSel
Next

For i = 1 To lIncrement + 1 'going down loop
rSel = rSel + 1
SelectCell rSel, cSel
Next

For i = 1 To lIncrement + 1 'going left loop
cSel = cSel - 1
SelectCell rSel, cSel
Next

For i = 1 To lIncrement + 1 'going up loop
rSel = rSel - 1
SelectCell rSel, cSel
Next
Loop

ERROROUT:

End Sub

Sub SelectCell(rSel As Long, cSel As Long)
Cells(rSel, cSel).Select
Sleep 500
End Sub

Sub Test()
CircleAway ActiveCell.Row, ActiveCell.Column
End Sub



Just paste the whole lot in a standard module in Excel and run the last Sub.


RBS

 

[RB Smissaert]

This is makes it all slightly clearer if it wasn't clear enough:


Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub CircleAway(lRow As Long, lColumn As Long)

'loop counter
Dim i As Long

'to keep track of row and column
Dim rSel As Long
Dim cSel As Long

Dim lCircleCount As Long
Dim lIncrement As Long

On Error GoTo ERROROUT

'starting cell
rSel = lRow
cSel = lColumn

'starting cell
SelectCell rSel, cSel, lCircleCount

Do 'circle loop
lCircleCount = lCircleCount + 1
lIncrement = 2 * lCircleCount

'one up to start with
rSel = rSel - 1
SelectCell rSel, cSel, lCircleCount

For i = 1 To lIncrement - 1 'going right loop
cSel = cSel + 1
SelectCell rSel, cSel, lCircleCount
Next
For i = 1 To lIncrement 'going down loop
rSel = rSel + 1
SelectCell rSel, cSel, lCircleCount
Next
For i = 1 To lIncrement 'going left loop
cSel = cSel - 1
SelectCell rSel, cSel, lCircleCount
Next
For i = 1 To lIncrement 'going up loop
rSel = rSel - 1
SelectCell rSel, cSel, lCircleCount
Next
Loop

ERROROUT:

End Sub

Sub SelectCell(rSel As Long, cSel As Long, lCircleCount As Long)
With Cells(rSel, cSel)
.Select
.Value = "array(" & rSel & ", " & cSel & ")"
If lCircleCount = 0 Then
.Interior.ColorIndex = 3
Else
If lCircleCount Mod 2 = 0 Then
.Interior.ColorIndex = 36
Else
.Interior.ColorIndex = 2
End If
End If
End With
Sleep 200
End Sub

Sub Test()
CircleAway ActiveCell.Row, ActiveCell.Column
End Sub


RBS

 

[Steve Rindsberg]

Given: A 5 x 5 matrix:

| 1 2 3 4 5
| 6 7 8 9 10
y 11 12 13 14 15
| 16 17 18 19 20
| 21 22 23 24 25
----------------------- x ----------------

Where if you select 13, the array function should return
13, 8, 9, 14, 19, 18, 17, 12, 7, 2, 3, 4, 5, 10, 15, 20, 25 . . .
note the spiral pattern clockwise around number 13.

Pseudocoding, using dbase I would use something like:

arrayname[x,y-1] && this would pull the number above 12 (7)
arrayname[x+1,y-1] && this would pull the number above and one
right
&& of 12 (8)
arrayname[x+1,y] && this would pull the number directly right

of 12 (13)

Any variant of VB or VBA should work similarly; you'd use arrayname(x,y-1) and
so forth rather than arrayname[x,y-1]