Permutations in VBA Excel

Question

I am trying to generate all the possible combinations of an array of characters. The input array has n characters, 5 <= n <= 7, and I would like to generate a second a

Answer 1

Solve it recursively.

For example, your n = 7 case. In the outer layer, you start with {A, B, C, D, E, F, G}. From this, you take one letter out; a different one 7 times. So you have 7 elements in this output array set, each with 6 letters: {A, B, C, D, E, F}, {A, B, C, D, E, G} etc.

For each of these outputs, you then further reduce using the same algorithm. You already know how to deal with {A, B, C, D, E, F}.

Answer 2

Just found one way to make it recursively and avoid double results. The code is pretty ugly cause I didn't have time to think how to use the loops here.

Public Function Permutacao(card1 As String, card2 As String, card3 As String, card4 As String, card5 As String, Optional card6 As String, Optional card7 As String)
  Dim A(1 To 7) As String
  Dim aux_A(1 To 7, 1 To 6) As String
  Dim aux2_A(1 To 6, 1 To 5) As String
  Dim final_A(1 To 42, 1 To 6) As String
  n = 5
  A(1) = card1
  A(2) = card2
  A(3) = card3
  A(4) = card4
  A(5) = card5
  If Not IsMissing(card6) Then
    A(6) = card6
    n = 6
  End If
  If Not IsMissing(card7) Then
    A(7) = card7
    n = 7
  End If
  If n = 5 Then
    final_A(1, 1) = A(1)
    final_A(1, 2) = A(2)
    final_A(1, 3) = A(3)
    final_A(1, 4) = A(4)
    final_A(1, 5) = A(5)
    ElseIf n = 6 Then
      k = 1
      final_A(k, 1) = A(1)
      final_A(k, 2) = A(2)
      final_A(k, 3) = A(3)
      final_A(k, 4) = A(4)
      final_A(k, 5) = A(5)
      k = 2
      final_A(k, 1) = A(1)
      final_A(k, 2) = A(2)
      final_A(k, 3) = A(3)
      final_A(k, 4) = A(4)
      final_A(k, 5) = A(6)
      k = 3
      final_A(k, 1) = A(1)
      final_A(k, 2) = A(2)
      final_A(k, 3) = A(3)
      final_A(k, 4) = A(6)
      final_A(k, 5) = A(5)
      k = 4
      final_A(k, 1) = A(1)
      final_A(k, 2) = A(2)
      final_A(k, 3) = A(6)
      final_A(k, 4) = A(4)
      final_A(k, 5) = A(5)
      k = 5
      final_A(k, 1) = A(1)
      final_A(k, 2) = A(6)
      final_A(k, 3) = A(3)
      final_A(k, 4) = A(4)
      final_A(k, 5) = A(5)
      k = 6
      final_A(k, 1) = A(6)
      final_A(k, 2) = A(2)
      final_A(k, 3) = A(3)
      final_A(k, 4) = A(4)
      final_A(k, 5) = A(5)
    ElseIf n = 7 Then
    k = 1
    aux_A(k, 1) = A(1)
    aux_A(k, 2) = A(2)
    aux_A(k, 3) = A(3)
    aux_A(k, 4) = A(4)
    aux_A(k, 5) = A(5)
    aux_A(k, 6) = A(6)
    k = 2
    aux_A(k, 1) = A(1)
    aux_A(k, 2) = A(2)
    aux_A(k, 3) = A(3)
    aux_A(k, 4) = A(4)
    aux_A(k, 5) = A(5)
    aux_A(k, 6) = A(7)
    k = 3
    aux_A(k, 1) = A(1)
    aux_A(k, 2) = A(2)
    aux_A(k, 3) = A(3)
    aux_A(k, 4) = A(4)
    aux_A(k, 5) = A(7)
    aux_A(k, 6) = A(6)
    k = 4
    aux_A(k, 1) = A(1)
    aux_A(k, 2) = A(2)
    aux_A(k, 3) = A(3)
    aux_A(k, 4) = A(7)
    aux_A(k, 5) = A(5)
    aux_A(k, 6) = A(6)
    k = 5
    aux_A(k, 1) = A(1)
    aux_A(k, 2) = A(2)
    aux_A(k, 3) = A(7)
    aux_A(k, 4) = A(4)
    aux_A(k, 5) = A(5)
    aux_A(k, 6) = A(6)
    k = 6
    aux_A(k, 1) = A(1)
    aux_A(k, 2) = A(7)
    aux_A(k, 3) = A(3)
    aux_A(k, 4) = A(4)
    aux_A(k, 5) = A(5)
    aux_A(k, 6) = A(6)
    k = 7
    aux_A(k, 1) = A(7)
    aux_A(k, 2) = A(2)
    aux_A(k, 3) = A(3)
    aux_A(k, 4) = A(4)
    aux_A(k, 5) = A(5)
    aux_A(k, 6) = A(6)
    c = 1
    k = 1
    While k <= 7
      If k < 2 Then
        final_A(c, 1) = aux_A(k, 1)
        final_A(c, 2) = aux_A(k, 2)
        final_A(c, 3) = aux_A(k, 3)
        final_A(c, 4) = aux_A(k, 4)
        final_A(c, 5) = aux_A(k, 5)
        c = c + 1
      End If
      
      If k < 3 Then
        final_A(c, 1) = aux_A(k, 1)
        final_A(c, 2) = aux_A(k, 2)
        final_A(c, 3) = aux_A(k, 3)
        final_A(c, 4) = aux_A(k, 4)
        final_A(c, 5) = aux_A(k, 6)
        c = c + 1
      End If
      
      If k < 4 Then
        final_A(c, 1) = aux_A(k, 1)
        final_A(c, 2) = aux_A(k, 2)
        final_A(c, 3) = aux_A(k, 3)
        final_A(c, 4) = aux_A(k, 6)
        final_A(c, 5) = aux_A(k, 5)
      c = c + 1
      End If
      
      If k < 5 Then
        final_A(c, 1) = aux_A(k, 1)
        final_A(c, 2) = aux_A(k, 2)
        final_A(c, 3) = aux_A(k, 6)
        final_A(c, 4) = aux_A(k, 4)
        final_A(c, 5) = aux_A(k, 5)
        c = c + 1
      End If
      
      If k < 6 Then
        final_A(c, 1) = aux_A(k, 1)
        final_A(c, 2) = aux_A(k, 6)
        final_A(c, 3) = aux_A(k, 3)
        final_A(c, 4) = aux_A(k, 4)
        final_A(c, 5) = aux_A(k, 5)
        c = c + 1
      End If
      
      If k < 7 Then
        final_A(c, 1) = aux_A(k, 6)
        final_A(c, 2) = aux_A(k, 2)
        final_A(c, 3) = aux_A(k, 3)
        final_A(c, 4) = aux_A(k, 4)
        final_A(c, 5) = aux_A(k, 5)
        c = c + 1
      End If
      k = k + 1
    Wend
  End If
  Permutacao = final_A
End Function

Answer 3

This is just an implementation of Bathsheba's suggestion and will generate all the 5-of-7's. First insert the following UDF in a standard module:

Public Function DropCH(sIn As String, L As Long) As String
    If L = 1 Then
        DropCH = Mid(sIn, 2)
        Exit Function
    End If

    ll = Len(sIn)
    If ll = L Then
        DropCH = Left(sIn, L - 1)
        Exit Function
    End If

    If L > ll Then
        DropCH = ""
        Exit Function
    End If
    DropCH = Mid(sIn, 1, L - 1) & Mid(sIn, L + 1)
End Function

Then place the 7 character string in A1. Then in C1 enter:

=DropCH($A$1,COLUMNS($A:A))

and copy C1 to D1 through I1.

In C2 enter:

=DropCH(C$1,ROW()-1)

and copy C2 from D2 through I2

Then to remove duplicates run this macro:

Sub DropDuplicates()
    Dim c As Collection, K As Long
    Set c = New Collection
    On Error Resume Next
    K = 1

    For Each r In Range("C2:I7")
        If r.Value <> "" Then
            c.Add r.Value, CStr(r.Value)
            If Err.Number = 0 Then
                Cells(K, "J").Value = r.Value
                K = K + 1
            Else
                Err.Number = 0
            End If
        End If
    Next r
    On Error GoTo 0
End Sub

This will place the results in column J