Forum Discussion

Uncle_Bear's avatar
Uncle_Bear
Copper Contributor
Nov 06, 2025
Solved

How to get all possible permutation in VBA

Hi,

We all know Benjamin Franklins Square.
How can I

  1. Get VBA to export a spreadsheet with all possible permutations for numbers 1-9.
  2. Filter out duplicates of the same number
  3. Filter out only combinations that the sum matches the criteria below
  • First 3 digits = 15
  • Second 3 digits = 15
  • Third 3 digits = 15
  • 1st, 4th, 7th = 15
  • 2nd, 5th, 8th = 15
  • 3rd, 6th, 9th = 15
  • 1st, 5th, 9th = 15
  • 3rd, 5th, 7th = 15

I hope you are following what I'm trying to do.

 

Thanks in advance,

 

Uncle Bear

Macros and VBA
  • Kidd_Ip's avatar
    Kidd_Ip
    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

     

5 Replies

  • Uncle_Bear's avatar
    Uncle_Bear
    Copper Contributor
    Dec 04, 2025

    Thought this over.

    Let's make it simple.

    Option #3

    1. Get all permutations for 3 digits 1-9
    2. Filter out those that = 15
    3. For all those permutations that = 15 add another 3 digits - only digits notalready used
    4. Filter out only those that digits 4-6 = 15
    5. For all those per that survived add "1" more digit
    6. Filter only those that digits 1,4,7 = 15
    7. Filter only those that digits 3,5,7 = 15
    8. For all those per that survived add "1" more digit
    9. Filter only those that digits 2,5,8 = 15
    10. For all those per that survived add "1" more digit
    11. Filter only those that digits 3,6,9 = 15
    12. Filter only those that digits 7,8,9 = 15
    13. Filter only those that digits 1,5,9 = 15

    If my calculations are correct this should get the quickest result.

    Thanks in advance

     

    Uncle Bear

  • Uncle_Bear's avatar
    Uncle_Bear
    Copper Contributor
    Dec 03, 2025

    Back again.
    I used this macro for my use cases until I stumbled into an issue.

    The total amount of Permutations for numbers 1-9 is 362,880. This amount is workable with a macro.

    My newest use case has over 1,000,000,000,000 permutations which understandably will not work.

    My thoughts are to use one of the following methods.

    I'll Bejamin's sq for an example.

    Option #1

    1. Get all possible permutations for row #1 (first 3 digits = 15).
    2. Get all possible permutations for row #2 (2nd 3 digits = 15). This will only use the digits not used in row #1.
    3. Get all possible permutations for row #3 (3rd 3 digits = 15). This will only use the digits not used in row #1 or #2.
    4. Filter out the remaining conditions (Columns = 15, Diagonal = 15)

    Option #2

    1. Find all possible permutations for 3-digit combinations 1-9.
    2. Filter out only those which = 15
    3. Get all permutations for 3 sets of 3 digits
    4. Filter out digits used more than once and column/diagonal =15

    I hope this was clear enough.

     

    Although I was able to edit the original macro for my use case, I am still nowhere near creating this new one.

    Thanks in advance!

     

    Uncle Bear

  • Kidd_Ip's avatar
    Kidd_Ip
    MVP
    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

     

Resources