A magic square needs no introduction and we come across it many times. A magic square is a square grid and the minimum size of a magic square is 3x3. The whole numbers in magic square appear only once and all cells are filled. The horizontal rows, vertical columns and main and secondary diagonals all add up to the same number. This number is called magic constant. The more about magic square can be read here - https://en.wikipedia.org/wiki/Magic_square

Below is a VBA code to construct a magic square for odd order i.e. you can create magic squares of size 3x3, 5x5, 7x7,9x9......

I have tested the magic square till 211x211....

The logic for creating an odd order magic square has been explained in the link given above. The logic has been coded in VBA. The macro will ask for what size of magic square is needed and it will create the magic square starting in cell B2 and will put thick border around the magic square created. I have code B2 as variables so that if anybody wants to change the starting cell, he can do that.

The Excel file related to this article can be downloaded from **Magic Square**

1. Make a backup of your workbook.

2. Open your workbook and ALT+F11

3. Locate your Workbook name in Project Explorer Window

4. Right click on your workbook name > Insert > Module

5. Copy paste the Macro code given

6. Go back to your Workbook and ALT+F8 to display Macro Window

7. Run your Macro named "MakeOddMagicSquare" from here

8. Delete you Macro if the Macro was needed to be run only once.

9. Otherwise save your file as .xlsm if you intend to reuse Macro again.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
Sub MakeOddMagicSquare() Application.ScreenUpdating = False On Error GoTo ExitSub Dim Size As Long, InputNumber As Long, r As Long, c As Long, GridSize As Long Dim FirstRow As Long, FirstCol As Long, LastRow As Long, LastCol As Long Dim OriginalRow As Long, OriginalCol As Long Size = Application.InputBox("The size of Magic Square, the number must be odd and greater than 2", Type:=1) If Size = 0 Then GoTo ExitSub 'Test the size - The number must be odd and should be >=3 If WorksheetFunction.IsEven(Size) Or Size < 3 Then MsgBox ("Number must be Odd and should not be less than 3") GoTo ExitSub End If 'I have decided to make the magic square starting cell B2...If you need just change FirstRow and SecondRow FirstRow = 2 FirstCol = 2 LastRow = FirstRow + Size - 1 LastCol = FirstCol + Size - 1 'Clear the Area for Magic Square Range(Cells(FirstRow - 1, FirstCol - 1), Cells(LastRow + 1, LastCol + 1)).Clear 'Determine the middle column on the basis of size parameter, row will remain the same 'This will be the cell where value 1 will be placed r = FirstRow c = FirstCol - 1 + WorksheetFunction.RoundUp(Size / 2, 0) 'Determine the number of elements GridSize = Size ^ 2 'Put value 1 in this InputNumber = 1 Cells(r, c) = InputNumber 'The rule is move up & right. If during moving up and right, you get outside the 'square then you need to wrap around 'If there is already a number filled in, come down 'Ref - https://en.wikipedia.org/wiki/Magic_square Do Until GridSize = 1 GridSize = GridSize - 1 OriginalRow = r OriginalCol = c r = r - 1 If r < FirstRow Then r = LastRow c = c + 1 If c > LastCol Then c = FirstCol If Cells(r, c) <> "" Then r = OriginalRow + 1 c = OriginalCol End If InputNumber = InputNumber + 1 Cells(r, c) = InputNumber Loop 'Apply the thick border around magic square Range(Cells(FirstRow, FirstCol), Cells(LastRow, LastCol)).BorderAround Weight:=xlMedium 'Autofit Magic Square Cells.EntireColumn.AutoFit Cells.EntireRow.AutoFit ExitSub: Application.ScreenUpdating = True End Sub |

JDNovember 21, 2016 at 1:23 pmif you enter 1 and 0s it puts out an error like you enter 10 or 100 or 1000 ... it thinks 1 and 0s are 1 but 100 or 10 isnt 1