Question

Background: I’m pulling all of the field names from a database into an array – I’ve got this part done without a problem, so I already have an array containing all the fields (allfields()) and I have a count of how many fields there are (numfields).

I am now trying to compile all of the unique combinations that can be made from those various field names. For example, if my three fields are NAME, DESCR, DATE, I would want to return the following:

• NAME, DESCR, DATE
• NAME, DESCR
• NAME, DATE
• DESCR, DATE
• NAME
• DESCR
• DATE

I’ve tried a few different things for this, including multiple nested loops, and modifying the answer here: How to make all possible sum combinations from array elements in VB to fit my needs, but it appears as though I do not have access to the necessary libaries (System or System.Collections.Generic) on my work PC, as it only has VBA.

Does anyone have a bit of VB code kicking around that would fulfill this purpose?

Thanks a lot!

Answer 1

I had a similar requirement some years ago. I do not remember why and I no longer have the code but I do remember the algorithm. For me this was a one-off exercise so I wanted an easy code. I did not care about efficiency.

I will assume one-based arrays because it makes for a marginally easier explanation. Since VBA supports one-based arrays, this should be OK although it is an easy adjustment to zero-based arrays if that is what you want.

AllFields(1 To NumFields) holds the names.

Have a Loop: For Inx = 1 To 2^NumFields – 1

Within the loop consider Inx as a binary number with bits numbered 1 to NumFields. For each N between 1 and NumFields, if bit N is one include AllFields(N) in this combination.

This loop generates the 2^NumFields – 1 combinations:

Names: A B C

Inx:          001 010 011 100 101 110 111

CombinationS:   C  B   BC A   A C AB  ABC

The only difficulty with VBA is getting the value of Bit N.

Extra section

With everyone having at go at implementing bits of my algorithm, I thought I had better show how I would have done it.

I have filled an array of test data with an nasty set of field names since we have not been told what characters might be in a name.

The subroutine GenerateCombinations does the business. I am a fan of recursion but I do not think my algorithm is complicated enough to justify its use in this case. I return the result in a jagged array which I prefer to concatenation. The output of GenerateCombinations is output to the immediate window to demonstrate its output.

Option Explicit

This routine demonstrates GenerateCombinations

Sub Test()

  Dim InxComb As Integer
  Dim InxResult As Integer
  Dim TestData() As Variant
  Dim Result() As Variant

  TestData = Array("A A", "B,B", "C|C", "D;D", "E:E", "F.F", "G/G")

  Call GenerateCombinations(TestData, Result)

  For InxResult = 0 To UBound(Result)
    Debug.Print Right("  " & InxResult + 1, 3) & " ";
    For InxComb = 0 To UBound(Result(InxResult))
      Debug.Print "[" & Result(InxResult)(InxComb) & "] ";
    Next
    Debug.Print
  Next

End Sub

GenerateCombinations does the business.

Sub GenerateCombinations(ByRef AllFields() As Variant, _
                                             ByRef Result() As Variant)

  Dim InxResultCrnt As Integer
  Dim InxField As Integer
  Dim InxResult As Integer
  Dim I As Integer
  Dim NumFields As Integer
  Dim Powers() As Integer
  Dim ResultCrnt() As String

  NumFields = UBound(AllFields) - LBound(AllFields) + 1

  ReDim Result(0 To 2 ^ NumFields - 2)  ' one entry per combination 
  ReDim Powers(0 To NumFields - 1)          ' one entry per field name

  ' Generate powers used for extracting bits from InxResult
  For InxField = 0 To NumFields - 1
    Powers(InxField) = 2 ^ InxField
  Next

 For InxResult = 0 To 2 ^ NumFields - 2
    ' Size ResultCrnt to the max number of fields per combination
    ' Build this loop's combination in ResultCrnt
    ReDim ResultCrnt(0 To NumFields - 1)
    InxResultCrnt = -1
    For InxField = 0 To NumFields - 1
      If ((InxResult + 1) And Powers(InxField)) <> 0 Then
        ' This field required in this combination
        InxResultCrnt = InxResultCrnt + 1
        ResultCrnt(InxResultCrnt) = AllFields(InxField)
      End If
    Next
    ' Discard unused trailing entries
    ReDim Preserve ResultCrnt(0 To InxResultCrnt)
    ' Store this loop's combination in return array
    Result(InxResult) = ResultCrnt
  Next

End Sub