Forum Discussion
Uncle_Bear
Nov 06, 2025Copper Contributor
How to get all possible permutation in VBA
Hi, We all know Benjamin Franklins Square. How can I Get VBA to export a spreadsheet with all possible permutations for numbers 1-9. Filter out duplicates of the same number Filter out only...
- Nov 07, 2025
Take this:
Sub MagicSquarePermutations() Dim nums As Variant nums = Array(1, 2, 3, 4, 5, 6, 7, 8, 9) Dim results As Collection Set results = New Collection Call Permute(nums, 0, results) ' Output results to sheet Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) ws.Cells.Clear Dim i As Long, arr As Variant i = 1 For Each arr In results ws.Cells(i, 1).Resize(1, 9).Value = arr i = i + 1 Next arr End Sub Sub Permute(nums As Variant, l As Integer, results As Collection) Dim r As Integer If l = UBound(nums) Then If IsMagic(nums) Then results.Add nums Else For r = l To UBound(nums) Swap nums(l), nums(r) Permute nums, l + 1, results Swap nums(l), nums(r) Next r End If End Sub Function IsMagic(nums As Variant) As Boolean IsMagic = _ nums(0) + nums(1) + nums(2) = 15 And _ nums(3) + nums(4) + nums(5) = 15 And _ nums(6) + nums(7) + nums(8) = 15 And _ nums(0) + nums(3) + nums(6) = 15 And _ nums(1) + nums(4) + nums(7) = 15 And _ nums(2) + nums(5) + nums(8) = 15 And _ nums(0) + nums(4) + nums(8) = 15 And _ nums(2) + nums(4) + nums(6) = 15 End Function Sub Swap(a As Variant, b As Variant) Dim tmp As Variant tmp = a: a = b: b = tmp End Sub
Kidd_Ip
Nov 07, 2025MVP
Take this:
Sub MagicSquarePermutations()
Dim nums As Variant
nums = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
Dim results As Collection
Set results = New Collection
Call Permute(nums, 0, results)
' Output results to sheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
ws.Cells.Clear
Dim i As Long, arr As Variant
i = 1
For Each arr In results
ws.Cells(i, 1).Resize(1, 9).Value = arr
i = i + 1
Next arr
End Sub
Sub Permute(nums As Variant, l As Integer, results As Collection)
Dim r As Integer
If l = UBound(nums) Then
If IsMagic(nums) Then results.Add nums
Else
For r = l To UBound(nums)
Swap nums(l), nums(r)
Permute nums, l + 1, results
Swap nums(l), nums(r)
Next r
End If
End Sub
Function IsMagic(nums As Variant) As Boolean
IsMagic = _
nums(0) + nums(1) + nums(2) = 15 And _
nums(3) + nums(4) + nums(5) = 15 And _
nums(6) + nums(7) + nums(8) = 15 And _
nums(0) + nums(3) + nums(6) = 15 And _
nums(1) + nums(4) + nums(7) = 15 And _
nums(2) + nums(5) + nums(8) = 15 And _
nums(0) + nums(4) + nums(8) = 15 And _
nums(2) + nums(4) + nums(6) = 15
End Function
Sub Swap(a As Variant, b As Variant)
Dim tmp As Variant
tmp = a: a = b: b = tmp
End Sub