Magic Squares

[jemidiah]

Well, I edited it seeing as it was using numbers more than once in the same box:

'Needs: a command button (Command1), a listbox (List1)
 
Option Explicit
 
 
Private Sub Command1_Click()
Dim i As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim i5 As Long
 
Dim RndVal1 As Long
Dim RndVal2 As Long
Dim RndVal3 As Long
 
Dim Number(1 To 9) As Long
Dim Permutations(1 To 3, 1 To 504) As Long
Dim PermutationsCulled() As Long
Dim CrossCheck(1 To 9) As Long
Dim TotalNumber As Single
 
'Here is where you store the numbers. Get them however you feel like,
    'just store them in this array
    'Ex. 0 1 2 4 6 8 5 10 9 should be entered like this:
Number(1) = 0
Number(2) = 1
Number(3) = 2
Number(4) = 4
Number(5) = 6
Number(6) = 8
Number(7) = 5
Number(8) = 10
Number(9) = 9
 
'Find all 504 permutations
Randomize
For i = 1 To 504
ReInit:
    RndVal1 = Int(Rnd * 9) + 1
    RndVal2 = Int(Rnd * 9) + 1
    RndVal3 = Int(Rnd * 9) + 1
    Do Until RndVal2 <> RndVal1
        RndVal2 = Int(Rnd * 9) + 1
    Loop
    Do Until RndVal3 <> RndVal2 And RndVal3 <> RndVal1
        RndVal3 = Int(Rnd * 9) + 1
    Loop
    For i2 = 1 To 504
        If Permutations(1, i2) = RndVal1 And Permutations(2, i2) = RndVal2 And Permutations(3, i2) = RndVal3 Then GoTo ReInit
    Next i2
    Permutations(1, i) = RndVal1
    Permutations(2, i) = RndVal2
    Permutations(3, i) = RndVal3
Next i
 
'Transfer the array while cutting out all permutations that do not
    'add up to Total Number / 3 plus checking to make sure all numbers
    'in Number array are used exactly once and displaying the % done
ReDim PermutationsCulled(1 To 3, 1 To 1) As Long
For i = 1 To 9
    TotalNumber = TotalNumber + Number(i)
Next i
For i = 1 To 504
    If Number(Permutations(1, i)) + Number(Permutations(2, i)) + Number(Permutations(3, i)) = TotalNumber / 3 Then
        PermutationsCulled(1, UBound(PermutationsCulled, 2)) = Number(Permutations(1, i))
        PermutationsCulled(2, UBound(PermutationsCulled, 2)) = Number(Permutations(2, i))
        PermutationsCulled(3, UBound(PermutationsCulled, 2)) = Number(Permutations(3, i))
        
        If i <> 504 Then ReDim Preserve PermutationsCulled(1 To 3, 1 To UBound(PermutationsCulled, 2) + 1) As Long
    End If
Next i
 
'Basically, loop through all possible squares and check whether or
    'not it's a magic square. Also, loop through the list and check whether
    'or not it's already been found
For i = 1 To UBound(PermutationsCulled, 2)
For i2 = 1 To UBound(PermutationsCulled, 2)
For i3 = 1 To UBound(PermutationsCulled, 2)
    If PermutationsCulled(1, i) + PermutationsCulled(1, i2) + PermutationsCulled(1, i3) = TotalNumber / 3 Then
    If PermutationsCulled(2, i) + PermutationsCulled(2, i2) + PermutationsCulled(2, i3) = TotalNumber / 3 Then
    If PermutationsCulled(3, i) + PermutationsCulled(3, i2) + PermutationsCulled(3, i3) = TotalNumber / 3 Then
        For i4 = 0 To List1.ListCount - 1 Step 4
            If List1.List(i4) = PermutationsCulled(1, i) & " " & PermutationsCulled(2, i) & " " & PermutationsCulled(3, i) Then
            If List1.List(i4 + 1) = PermutationsCulled(1, i2) & " " & PermutationsCulled(2, i2) & " " & PermutationsCulled(3, i2) Then
            If List1.List(i4 + 2) = PermutationsCulled(1, i3) & " " & PermutationsCulled(2, i3) & " " & PermutationsCulled(3, i3) Then
                GoTo SkipIf
            End If
            End If
            End If
        Next i4
        
        For i4 = 1 To 9
            CrossCheck(i4) = Number(i4)
        Next i4
        For i4 = 1 To 3
            For i5 = 1 To 9
                If CrossCheck(i5) = PermutationsCulled(i4, i) And CrossCheck(i5) <> 0 Then
                    CrossCheck(i5) = 0
                    Exit For
                End If
            Next i5
        Next i4
        For i4 = 1 To 3
            For i5 = 1 To 9
                If CrossCheck(i5) = PermutationsCulled(i4, i2) And CrossCheck(i5) <> 0 Then
                    CrossCheck(i5) = 0
                    Exit For
                End If
            Next i5
        Next i4
        For i4 = 1 To 3
            For i5 = 1 To 9
                If CrossCheck(i5) = PermutationsCulled(i4, i3) And CrossCheck(i5) <> 0 Then
                    CrossCheck(i5) = 0
                    Exit For
                End If
            Next i5
        Next i4
        i5 = 0
        For i4 = 1 To 9
            i5 = i5 + CrossCheck(i4)
        Next i4
        
        If i5 <> 0 Then GoTo SkipIf
        
        List1.AddItem PermutationsCulled(1, i) & " " & PermutationsCulled(2, i) & " " & PermutationsCulled(3, i)
        List1.AddItem PermutationsCulled(1, i2) & " " & PermutationsCulled(2, i2) & " " & PermutationsCulled(3, i2)
        List1.AddItem PermutationsCulled(1, i3) & " " & PermutationsCulled(2, i3) & " " & PermutationsCulled(3, i3)
        List1.AddItem ""
        
        Me.Refresh
        DoEvents
    End If
    End If
    End If
SkipIf:
Next i3
Next i2
Command1.Caption = Int(i / UBound(PermutationsCulled, 2) * 100) & "%"
Next i
 
Command1.Caption = "Command1"
End Sub

That should give you every single magic square a block of numbers can make. Again, it's amazingly fast for all the loops it uses. Please do note that the more possible magic square there are, the longer it will take (ie, [2, 2, 2, 2, 2, 2, 2, 2, 2] will take forever compared to [0, 1, 2, 4, 6, 8, 5, 10, 9] which will take maybe half a second]

Edit: Somehow my mind wandered back to this and thought the diagonals aren't being checked (though they aren't mentioned in the problem). To check them too, you'd use this:

If PermutationsCulled(1, i) + PermutationsCulled(1, i2) + PermutationsCulled(1, i3) = TotalNumber / 3 Then
    If PermutationsCulled(2, i) + PermutationsCulled(2, i2) + PermutationsCulled(2, i3) = TotalNumber / 3 Then
    If PermutationsCulled(3, i) + PermutationsCulled(3, i2) + PermutationsCulled(3, i3) = TotalNumber / 3 Then
    [b]If PermutationsCulled(1, i) + PermutationsCulled(2, i2) + PermutationsCulled(3, i3) = TotalNumber / 3 Then[/b]
    [b]If PermutationsCulled(3, i) + PermutationsCulled(2, i2) + PermutationsCulled(1, i3) = TotalNumber / 3 Then[/b]

with the proper End If's