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 array A( C( n , 5 ) , 5 ) that contains all the C( n , 5 ) combinations. The order of the characters in the array isn't important.

Here is an example: input array: { A, B, C, D, E, F } , so n = 6 output array should be:

{A B C D E},
{A B C D F},
{A B C F E},
{A B F D E},
{A F C D E},
{F B C D E},

This is pretty simple for n=5 and n=6, but gets very complicated for n=7. Does anyone know how should I make this ?

Thanks

Try searching for "permutations" on [codereview.se] for working examples in many languages (not sure I've seen one in VBA though, but once you get your code to work as intended, I encourage you to put it up for review there) — Mathieu Guindon, Mar 16 '15 at 14:00
Do you really need all the combinations? What are you going to use them for? — Simon Forsberg, Mar 16 '15 at 14:47
It is the way I found to find the best hand in a poker texas holdem game. By the river you have 7 cards and your final hand is the best combination with 5 cards. — José Arivar, Mar 16 '15 at 14:59

Bathsheba · Answer 1 · 2015-03-16T14:00:15.873

0

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}.

edited Mar 16 '15 at 14:00

answered Mar 16 '15 at 13:51

Bathsheba

231,907
34
361
483

I thought about that, but if I do that recursively I would have 7 arrays of 6 elements each. Each one of the 7 arrays would generate another 6 arrays of 5 elements, which means that I am going to end up with 42 arrays of 5 elements, instead of 21. Any idea how to avoid double elements ? – José Arivar Mar 16 '15 at 14:30
You maintain a sorted output result set. Insertion into that set is O(log N), so not too bad performance wise. – Bathsheba Mar 16 '15 at 14:38
Sorry, could you please elaborate a bit more ? Thanks – José Arivar Mar 16 '15 at 14:44
The only problem is that I need this to run a monte carlo simulation later and if I have the double of the results for each iteration the simulation time would make it useless. – José Arivar Mar 16 '15 at 14:55

Gary's Student · Answer 2 · 2015-03-16T14:58:21.370

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

enter image description here

score 0 · Accepted Answer · edited Sep 01 '20 at 17:07

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

Permutations in VBA Excel

3 Answers3

Linked