Creating a list of all possible unique combinations from an array (using VBA)

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!

What are you trying to achieve by doing this? Insight into the goal a problem is trying to achieve often leads to better ways of achieving that goal. — cdeszaq
– cdeszaq, Commented Jan 6, 2012 at 15:40
I'm using it with general ledgers from accounting databases, where the GL itself does not have a transaction identifier / unique ID field that I can use to isolate specific transactions. So what I'm trying to do is find the most adequate combination of fields to create such a unique ID field, without having to manually test all of the possible combinations myself. — dmacp
– dmacp, Commented Jan 6, 2012 at 15:49
So, you are looking for a combination of fields that the current data indicates is unique, rather than a set of fields that the domain indicates is unique? That sounds like a recipe for disaster. If you pick a set of fields as an identifier and it turns out that it isn't down the road, you might find yourself in a world of pain. — cdeszaq
– cdeszaq, Commented Jan 6, 2012 at 15:55
I have another program that I can use to determine whether or not the specific combination is unique - it takes each transaction based on the identifier and totals them all, then calculates the number and percentage of transactions that balance to zero. The more transactions that balance to zero, the better the identifier. So that's not the problem - it's just a matter of compiling a list of all of the unique combinations of the field names, and then I'll be able to work from there quite easily. — dmacp
– dmacp, Commented Jan 6, 2012 at 16:01

Tony Dallimore · Accepted Answer · 2012-01-07 01:34:17Z

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

Dick Kusleika · Accepted Answer · 2012-01-06 21:22:11Z

2

Here's some code that will do what you want. It assigns a zero or one to each element and joins up the elements that are assigned a one. With four elements, for example, you have 2^4 combinations. Represented as zeros and ones, it would look like

This code creates an array(maInclude) that replicates all 16 of those scenarios and uses the corresponding mvArr element to concatenate the results.

Option Explicit

Dim mvArr As Variant
Dim maResult() As String
Dim maInclude() As Long
Dim mlElementCount As Long
Dim mlResultCount As Long

Sub AllCombos()

    Dim i As Long

    'Initialize arrays and variables
    Erase maInclude
    Erase maResult
    mlResultCount = 0

    'Create array of possible substrings
    mvArr = Array("NAME", "DESC", "DATE", "ACCOUNT")

    'Initialize variables based on size of array
    mlElementCount = UBound(mvArr)
    ReDim maInclude(LBound(mvArr) To UBound(mvArr))
    ReDim maResult(1 To 2 ^ (mlElementCount + 1))

    'Call the recursive function for the first time
    Eval 0

    'Print the results to the immediate window
    For i = LBound(maResult) To UBound(maResult)
        Debug.Print i, maResult(i)
    Next i

End Sub


Sub Eval(ByVal lPosition As Long)

    Dim sConcat As String
    Dim i As Long

    If lPosition <= mlElementCount Then
        'set the position to zero (don't include) and recurse
        maInclude(lPosition) = 0
        Eval lPosition + 1

        'set the position to one (include) and recurse
        maInclude(lPosition) = 1
        Eval lPosition + 1
    Else
        'once lPosition exceeds the number of elements in the array
        'concatenate all the substrings that have a corresponding 1
        'in maInclude and store in results array
        mlResultCount = mlResultCount + 1
        For i = 0 To UBound(maInclude)
            If maInclude(i) = 1 Then
                sConcat = sConcat & mvArr(i) & Space(1)
            End If
        Next i
        sConcat = Trim(sConcat)
        maResult(mlResultCount) = sConcat
    End If

End Sub

Recursion makes my head hurt, but it sure is powerful. This code was adapted from Naishad Rajani whose original code can be found at http://www.dailydoseofexcel.com/archives/2005/10/27/which-numbers-sum-to-target/

answered Jan 6, 2012 at 21:22

community wiki

Dick Kusleika

9 Comments

Tony Dallimore Over a year ago

I do not think it is appropriate to create an answer which is a duplicate of an earlier one. You claim to have copied someone else algorithm rahter than mine but I do not see that as an excuse.

Jean-François Corbett Over a year ago

@TonyDallimore: How is this a duplicate of your solution? The only superficial similarity is the use of 0's and 1's to represent a boolean value (include/do not include field name) which is a generic part of this problem.

Tony Dallimore Over a year ago

@Jean-François Corbett. Two factors behind my rather bitter comment. (1) Yesterday I saw an question with the answer as a comment. An hour or so later someone had duplicated the comment as an answer. I saw this as a naked attempt to steal someone else's credit and points. (2) I finished work late last night (early this morning) and I had a final check of Stack Overflow before bed. I saw what at first glance appeared to be a crude implementation of my algorithm without credit. Hence my bitter comment.

Tony Dallimore Over a year ago

I have been the author of rival answers. Sometimes two of us have clearly taken the time to create a detailed answer which we have posted without knowledge of the other. If I post a rival answer when I have seen the earlier answer first, I acknowledge the earlier answer and explain why I am posting a rival. Perhaps I think my answer is superior; more often it is just different and wish to alert the OP to an alternative approach that might be more suitable. I consider the acknowledgement and explanation a necessary courtesy.

brettdj Over a year ago

@TonyDallimore Kudos for your gracious retraction. While I certainly understand your frustration, I've found that in the forums I've been involved in the "regulars" typically set the tone for what is acceptable, which often in the Excel space is a higher standard than the overall forum. The offenders tend to be site newbies, or irregular contributors, I think in this case a check of Dick's record may have recalibrated your annoyance.

|

chris neilsen · Accepted Answer · 2012-01-06 20:59:14Z

0

to build on Tony's answer: (where A = 4, B = 2, C = 1)

(the following is pseudocode)

If (A And Inx <> 0) then
  A = True
end if

edited Jan 6, 2012 at 20:59

chris neilsen

53.3k10 gold badges91 silver badges127 bronze badges

answered Jan 6, 2012 at 18:04

Harry

2561 gold badge2 silver badges14 bronze badges

Collectives™ on Stack Overflow

Creating a list of all possible unique combinations from an array (using VBA)

3 Answers 3

Comments

9 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

9 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related