'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