calculating all combinations, adjust code

[perrush]

Hi,

I'm using the following code to calculate all combinations of 3 variables.
found in this thread

Sub Perm()Dim rSets As Range, rOut As Range
Dim vArr As Variant, lrow As Long
 
Set rSets = Range("A1").CurrentRegion
ReDim vArr(1 To rSets.Columns.Count)
Set rOut = Cells(1, rSets.Columns.Count + 2)
Perm1 rSets, vArr, rOut, 1, lrow
End Sub
 
Sub Perm1(rSets As Range, ByVal vArr As Variant, rOut As Range, ByVal lSetN As Long, lrow As Long)
Dim j As Long
 
For j = 1 To rSets.Rows.Count
    If rSets(j, lSetN) = "" Then Exit Sub
    vArr(lSetN) = rSets(j, lSetN)
    If lSetN = rSets.Columns.Count Then
        lrow = lrow + 1
        rOut(lrow).Resize(1, rSets.Columns.Count).Value = vArr
    Else
        Perm1 rSets, vArr, rOut, lSetN + 1, lrow
    End If
Next j
End Sub

This code calculates all combinations starting from row 1. I would like to have a header in row 1. Can the code be adjusted in that way or would that be too hard ?

regards
Stefan

 

[James006]

Hi,

You can the sub perm1() as it is .... and only use as the main perm macro

Sub Perm()
Dim rSets As Range, rOut As Range
Dim vArr As Variant, lrow As Long
 
Set rSets = Range("A2:D4")
ReDim vArr(1 To rSets.Columns.Count)
Set rOut = Cells(2, rSets.Columns.Count + 2)
Perm1 rSets, vArr, rOut, 1, lrow
End Sub

Hope this will help

 

[perrush]

If I see it correct, I should only replace

Set rSets = Range("A1").CurrentRegion

by

Set rSets = Range("A2:D4")

But that doesn't work, so I'll probably overlooked something

 

[James006]

Re,

In fact ... a couple of replacements to be tested :

1. Set rSets = Range("A2:D4")

2. Set rOut = Cells(2, rSets.Columns.Count + 2)

HTH

 

[perrush]

Hi,

the Set rOut = Cells(2, rSets.Columns.Count + 2) works fine

but using Set rSets = Range("A2:D4") disables the macro. Doesn't run.

 

[James006]

Hi again,

Just carried out a test ... and it is working fine at my end ... :wink:

All the permutations appear in range F2:I37 ...

What is your actual input range ?

Sub Perm()
Dim rSets As Range
Dim rOut As Range
Dim vArr As Variant
Dim lrow As Long
 
Set rSets = Range("A2:D4")
ReDim vArr(1 To rSets.Columns.Count)
Set rOut = Cells(2, rSets.Columns.Count + 2)
Perm1 rSets, vArr, rOut, 1, lrow
End Sub

 

[perrush]

Hi,

just replaced my Sub Perm() by yours, but then as said the macro doesn't run anymore.

My input is as shown below. Where AA, BB, CC are just dummy for headers. These I want to leave out in the combinations. note : AA is in cel A1

[TABLE="width: 192"]
<tbody>[TR]
[TD="class: xl64, width: 64"]AA[/TD]
[TD="class: xl64, width: 64"]BB[/TD]
[TD="class: xl64, width: 64"]CC[/TD]
[/TR]
[TR]
[TD="class: xl65"]53503[/TD]
[TD="class: xl65"]53503[/TD]
[TD]B090C015[/TD]
[/TR]
[TR]
[TD="class: xl65"]496536[/TD]
[TD="class: xl65"]496536[/TD]
[TD]B090D015[/TD]
[/TR]
[TR]
[TD="class: xl65"]40668[/TD]
[TD="class: xl65"]40668[/TD]
[TD]B090D016[/TD]
[/TR]
[TR]
[TD="class: xl64"][/TD]
[TD="class: xl64"][/TD]
[TD]B090R016[/TD]
[/TR]
</tbody>[/TABLE]

 

[James006]

Hi,

Based on your input area ...

Could you test again with the following instruction : Set rSets = Range("A2:C5")

HTH

 

[perrush]

Hi,

The fault was using column D instead of C. If I use range A2:C999 it works fine for every number of data I put in

tnx

 

[James006]

Hi,

The fault was using column D instead of C. If I use range A2:C999 it works fine for every number of data I put in

tnx

Glad you could fix your problem ...