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 Get VBA to export a spreadsheet with all possible permutations for numbers 1-9. Filter out duplicates of the same number Filter out only...
  • Kidd_Ip's avatar
    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