Permutations/Combinations using VBA

Question

Hello,

I came across this question in a different forum (I've modified it slightly). It was posted about 10 years ago and didnt seem to get any responses that answered the question sprecifically. Any chance anyone here knows how to solve it?

Can someone help me with an elusive permutations/combinations problem using VBA? I want to generate a list of possible combinations of variables (set of six). For example:

A1	B1	C1	D1	E1	F1
A2	B2	C2	D2	E2	F2
A3	B3			E3	F3
A4	B4

The first six sets would be:

Set 1 = A1,B1,C1,D1,E1,F1

Set 2 = A1,B1,C1,D1,E1,F2

Set 3 = A1,B1,C1,D1,E1,F3

Set 4 = A1,B1,C1,D1,E2,F1

Set 5 = A1,B1,C1,D1,E3,F1

Set 6 = A1,B1,C1,D1,E2,F2

*Possible for more than just 6 variables

Any help would be appreciated, thanks in advance! :)

Answer 1

Thanks Hans, unfortuneately thats not quite what I wos looking for. But in after some googling, I came across this bit of code with seems to do what I was looking for. It's quite lengthy, and although relatively quick with a small data set, take would take a while with a larger set. Might have to look into editing it to use arrays.

`Sub sub_CrossJoin()

Dim rg_Selection As Range Dim rg_Col As Range Dim rg_Row As Range Dim rg_Cell As Range Dim rg_DestinationCol As Range Dim rg_DestinationCell As Range Dim int_PriorCombos As Integer Dim int_TotalCombos As Integer Dim int_ValueRowCount As Integer Dim int_ValueRepeats As Integer Dim int_ValueRepeater As Integer Dim int_ValueCycles As Integer Dim int_ValueCycler As Integer

int_TotalCombos = 1 int_PriorCombos = 1 int_ValueRowCount = 0 int_ValueCycler = 0 int_ValueRepeater = 0

Set rg_Selection = Selection Set rg_DestinationCol = rg_Selection.Cells(1, 1) Set rg_DestinationCol = rg_DestinationCol.Offset(0, rg_Selection.Columns.Count)

'get total combos For Each rg_Col In rg_Selection.Columns     int_ValueRowCount = 0     For Each rg_Row In rg_Col.Cells         If rg_Row.Value = "" Then             Exit For         End If         int_ValueRowCount = int_ValueRowCount

• 1     Next rg_Row     int_TotalCombos = int_TotalCombos

• int_ValueRowCount Next rg_Col

int_ValueRowCount = 0

'for each column, calculate the repeats needed for each row value and then populate the destination For Each rg_Col In rg_Selection.Columns     int_ValueRowCount = 0     For Each rg_Row In rg_Col.Cells         If rg_Row.Value = "" Then             Exit For         End If         int_ValueRowCount = int_ValueRowCount

• 1     Next rg_Row     int_PriorCombos = int_PriorCombos

• int_ValueRowCount     int_ValueRepeats = int_TotalCombos / int_PriorCombos

    int_ValueCycles = (int_TotalCombos / int_ValueRepeats) / int_ValueRowCount     int_ValueCycler = 0

    int_ValueRepeater = 0

    Set rg_DestinationCell = rg_DestinationCol

    For int_ValueCycler = 1 To int_ValueCycles         For Each rg_Row In rg_Col.Cells             If rg_Row.Value = "" Then                 Exit For             End If

                For int_ValueRepeater = 1 To int_ValueRepeats                     rg_DestinationCell.Value = rg_Row.Value                     Set rg_DestinationCell = rg_DestinationCell.Offset(1, 0)                 Next int_ValueRepeater

        Next rg_Row     Next int_ValueCycler

    Set rg_DestinationCol = rg_DestinationCol.Offset(0, 1) Next rg_Col End Sub

`

Answer 2

One thing that might help speed things up would be to put this statement

Application.ScreenUpdating = False

right after the last Dim statement (it could actually go further down - just needs to be executed before the routine starts writing results to the sheet).  This can often speed up the overall time it takes a process that has lots of output dramatically.  You don't have to set it back to =True anywhere, it does that automatically when it gets to the End Sub statement.

The problem is that you get no visual indication that things are happening until it is completely finished.

Answer 3

See Permutations and Combinations.