VB Excel: Spiral Matrix in Clockwise Direction

S

sunilhaokha

New Member
Joined
Aug 10, 2020
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
Solve this problem in VB Excel:
Q. Print matrix elements as spiral order (in clockwise direction as given in example) beginning from the center position of n x n order.
Also print the color formatting as given in example.
Here example of n = 5 ie., 5 x 5 order:

Matrix Spiral.png
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
Assuming that the table is in A1:E5.

New Document (2).xlsx
ABCDE
11314151617
21234518
31121619
41098720
52524232221
6
7ValueLabelColorIndex
81Color Index33
92Color Index6
103Color Index33
114Color Index6
125Color Index33
136Color Index6
147Color Index33
158Color Index6
169Color Index33
1710Color Index2
1811Color Index6
1912Color Index2
2013Color Index33
2114Color Index2
2215Color Index6
2316Color Index2
2417Color Index33
2518Color Index2
2619Color Index6
2720Color Index2
2821Color Index33
2922Color Index2
3023Color Index6
3124Color Index2
3225Color Index33
Sheet5


VBA Code: 
Sub SPIRAL()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim AR() As Variant:    AR = Range("A1:E5").Value2
Dim x As Integer:       x = 3
Dim y As Integer:       y = 3
Dim mCnt As Integer:    mCnt = 1
Dim Limit As Integer:   Limit = UBound(AR) + UBound(AR) - 1

For i = 1 To Limit
    If (i Mod 2 = 1 And i <> 1 And i <> Limit) Then mCnt = mCnt + 1
    Select Case i Mod 4
        Case 0
            ListVals x, y, mCnt, AR, True, True
        Case 1
            ListVals x, y, mCnt, AR, False, False
        Case 2
            ListVals x, y, mCnt, AR, False, True
        Case 3
            ListVals x, y, mCnt, AR, True, False
    End Select
Next i

Debug.Print (AR(x, y)) & " - Color Index: " & Cells(x, y).Interior.ColorIndex

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub ListVals(x As Integer, y As Integer, mCnt As Integer, AR() As Variant, Sign As Boolean, XY As Boolean)
For i = 1 To mCnt
    Debug.Print (AR(x, y)) & " - Color Index: " & Cells(x, y).Interior.ColorIndex
    If XY Then
        If Sign Then x = x + 1 Else x = x - 1
    Else
        If Sign Then y = y + 1 Else y = y - 1
    End If
Next i
End Sub
 
Upvote 0
Here is another version that is a bit better. Everything is done with range objects, no arrays. So all you would need to do is adjust the range for variable r. The previous version needed the matrix to begin in A1, now it can be anywhere.

VBA Code: 
Sub SPIRALCELLS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim r As Range:         Set r = Range("A1:G7")
Dim mCnt As Integer:    mCnt = 0
Dim Limit As Integer:   Limit = (r.Rows.Count * 2) - 1
Dim oSet As Integer:    oSet = ((r.Rows.Count + 1) / 2) - 1
Dim sCel As Range:      Set sCel = r.Cells(1, 1).Offset(oSet, oSet)

For i = 1 To Limit
    If (i Mod 2 = 1 And i <> Limit) Then mCnt = mCnt + 1
    Select Case i Mod 4
        Case 0
            ListCells sCel, mCnt, True, True
        Case 1
            ListCells sCel, mCnt, False, False
        Case 2
            ListCells sCel, mCnt, False, True
        Case 3
            ListCells sCel, mCnt, True, False
    End Select
Next i

Debug.Print (sCel.Value2) & " - Color Index: " & sCel.Interior.ColorIndex

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub ListCells(sCel As Range, mCnt As Integer, Sign As Boolean, XY As Boolean)
For i = 1 To mCnt
    Debug.Print (sCel.Value2) & " - Color Index: " & sCel.Interior.ColorIndex
    If XY Then
        If Sign Then Set sCel = sCel.Offset(1) Else Set sCel = sCel.Offset(-1)
    Else
        If Sign Then Set sCel = sCel.Offset(, 1) Else Set sCel = sCel.Offset(, -1)
    End If
Next i
End Sub

New Document (2).xlsx
ABCDEFG
131323334353637
230131415161738
329123451839
428112161940
527109872041
626252423222142
749484746454443
Sheet5


Console Output:
1 - Color Index: 33
2 - Color Index: 6
3 - Color Index: 33
4 - Color Index: 6
5 - Color Index: 33
6 - Color Index: 6
7 - Color Index: 33
8 - Color Index: 6
9 - Color Index: 33
10 - Color Index: 2
11 - Color Index: 6
12 - Color Index: 2
13 - Color Index: 33
14 - Color Index: 2
15 - Color Index: 6
16 - Color Index: 2
17 - Color Index: 33
18 - Color Index: 2
19 - Color Index: 6
20 - Color Index: 2
21 - Color Index: 33
22 - Color Index: 2
23 - Color Index: 6
24 - Color Index: 2
25 - Color Index: 33
26 - Color Index: 48
27 - Color Index: 46
28 - Color Index: 48
29 - Color Index: 46
30 - Color Index: 48
31 - Color Index: 46
32 - Color Index: 48
33 - Color Index: 46
34 - Color Index: 48
35 - Color Index: 46
36 - Color Index: 48
37 - Color Index: 46
38 - Color Index: 48
39 - Color Index: 46
40 - Color Index: 48
41 - Color Index: 46
42 - Color Index: 48
43 - Color Index: 46
44 - Color Index: 48
45 - Color Index: 46
46 - Color Index: 48
47 - Color Index: 46
48 - Color Index: 48
49 - Color Index: 46
 
Upvote 0
What about the coding for the problem in first line? ie., Print matrix elements as spiral order (in clockwise direction as given in example) beginning from the center position of n x n order.
 
Upvote 0
It depends on what you mean by print. The code is executing debug.print commands to print the values in the squares. Is the point of the code to be putting the values in via the code?
 
Upvote 0
Whilst this sounds like a home work assignment, I think the idea is you input a grid size & the code then creates & populates the grid.
 
Upvote 0
I had a feeling it was homework. Just thought it would be a bit of fun to figure it out. I know I've read that it is the policy of the forum not to answer homework questions in posts, but I didn't see in the rules & guidelines where it mentioned it. Is it actually against the rules or frowned upon?
 
Upvote 0
Having said that... here is some updated code.

VBA Code: 
Sub SPIRALCELLS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim r As Range:         Set r = Range("A1:E5")
Dim mCnt As Integer:    mCnt = 0
Dim Pos As Integer:     Pos = 1
Dim Limit As Integer:   Limit = (r.Rows.Count * 2) - 1
Dim oSet As Integer:    oSet = ((r.Rows.Count + 1) / 2) - 1
Dim sCel As Range:      Set sCel = r.Cells(1, 1).Offset(oSet, oSet)
Dim YB As Boolean:      YB = True

With r
    With .Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .RowHeight = 24.75
    .ColumnWidth = 5
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
    

For i = 1 To Limit
    If (i Mod 2 = 1 And i <> Limit) Then mCnt = mCnt + 1
    Select Case i Mod 4
        Case 0
            ListCells sCel, mCnt, True, True, YB, Pos
        Case 1
            ListCells sCel, mCnt, False, False, YB, Pos
        Case 2
            ListCells sCel, mCnt, False, True, YB, Pos
        Case 3
            ListCells sCel, mCnt, True, False, YB, Pos
    End Select
Next i

sCel.Value = Pos
sCel.Interior.ColorIndex = 8

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub ListCells(sCel As Range, mCnt As Integer, Sign As Boolean, XY As Boolean, YB As Boolean, Pos As Integer)
For i = 1 To mCnt
    sCel.Value = Pos
    If Pos < 10 Then
        Select Case Pos Mod 2
            Case 0
                sCel.Interior.ColorIndex = 6
            Case 1
                sCel.Interior.ColorIndex = 8
        End Select
    Else
        Select Case Pos Mod 2
            Case 0
                sCel.Interior.ColorIndex = 2
            Case 1
                sCel.Interior.ColorIndex = IIf(YB, 6, 8)
                YB = Not YB
        End Select
    End If
    If XY Then
        If Sign Then Set sCel = sCel.Offset(1) Else Set sCel = sCel.Offset(-1)
    Else
        If Sign Then Set sCel = sCel.Offset(, 1) Else Set sCel = sCel.Offset(, -1)
    End If
    Pos = Pos + 1
Next i
End Sub
 
Upvote 0
Solution
lrobbo314 said:
Is it actually against the rules or frowned upon?
Click to expand...
We prefer it if members point the OP towards an answer & help to correct any mistakes the OP has made, but it's really down to the individual helper.
 
Upvote 0
lrobbo314 said:
Having said that... here is some updated code.

VBA Code: 
Sub SPIRALCELLS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim r As Range:         Set r = Range("A1:E5")
Dim mCnt As Integer:    mCnt = 0
Dim Pos As Integer:     Pos = 1
Dim Limit As Integer:   Limit = (r.Rows.Count * 2) - 1
Dim oSet As Integer:    oSet = ((r.Rows.Count + 1) / 2) - 1
Dim sCel As Range:      Set sCel = r.Cells(1, 1).Offset(oSet, oSet)
Dim YB As Boolean:      YB = True

With r
    With .Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    .RowHeight = 24.75
    .ColumnWidth = 5
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
   

For i = 1 To Limit
    If (i Mod 2 = 1 And i <> Limit) Then mCnt = mCnt + 1
    Select Case i Mod 4
        Case 0
            ListCells sCel, mCnt, True, True, YB, Pos
        Case 1
            ListCells sCel, mCnt, False, False, YB, Pos
        Case 2
            ListCells sCel, mCnt, False, True, YB, Pos
        Case 3
            ListCells sCel, mCnt, True, False, YB, Pos
    End Select
Next i

sCel.Value = Pos
sCel.Interior.ColorIndex = 8

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sub ListCells(sCel As Range, mCnt As Integer, Sign As Boolean, XY As Boolean, YB As Boolean, Pos As Integer)
For i = 1 To mCnt
    sCel.Value = Pos
    If Pos < 10 Then
        Select Case Pos Mod 2
            Case 0
                sCel.Interior.ColorIndex = 6
            Case 1
                sCel.Interior.ColorIndex = 8
        End Select
    Else
        Select Case Pos Mod 2
            Case 0
                sCel.Interior.ColorIndex = 2
            Case 1
                sCel.Interior.ColorIndex = IIf(YB, 6, 8)
                YB = Not YB
        End Select
    End If
    If XY Then
        If Sign Then Set sCel = sCel.Offset(1) Else Set sCel = sCel.Offset(-1)
    Else
        If Sign Then Set sCel = sCel.Offset(, 1) Else Set sCel = sCel.Offset(, -1)
    End If
    Pos = Pos + 1
Next i
End Sub
Click to expand...
your coding helps me but the colorindex that you have resulted is different from the original post....but thank you
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question Question
Lambda or VBA to solve the pairs webinar problem!!!
Replies
0
Views
129
Phantom1
P
P
  • Question Question
TypeScript (or other solutions) for modifying given list of cells (and similar problems)
Replies
0
Views
284
Pingaware
P
S
  • Question Question
Sorting: Prioritizing Group retention over Order
Replies
0
Views
75
stretch2011
S
A
  • Question Question
Excel VB Organogram
Replies
1
Views
305
anuradhagrewal
A
J
  • Question Question
VB Macro for extracting Excel email address data to Outlook email draft
Replies
0
Views
882
Jaydee12
J

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top