Solved

# Combination Generator

Posted on 2011-03-09
1,263 Views
Lets say I have two 3 digit numbers 123 ans 234. So If I break it up there are 6 numbers say 1,2,3,2,3,4

So as per the formula as shown below if I want to generate all 3 digit combinations from the above 6 numbers. I believe the possible number of combination is 11 combinations?

(n+r-1)! /  (r!(n-1)!)
n = 6
r = 3
(6+3-1)! / 3!(6-1)!

If that is correct then how do I code the same in VBA? Can a generic Function can be written where I pass an Array of n numbers and it outputs the result in an excel sheet?

Sid
0
Question by:SiddharthRout
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 12
• 9
• 3
• +1

LVL 27

Expert Comment

ID: 35084335

Sort your list of numbers:  1 2 2 3 3 4

122  123  124  133  134
223  224  233  234
334

I only get ten combinations.
0

LVL 30

Author Comment

ID: 35084390
Few you missed.

221, 331 etc...

Sid
0

LVL 27

Expert Comment

ID: 35084447
221 is the same as 122 if you are doing COMBINATIONS (order doesn't matter).

If order matters, you are doing PERMUTATIONS.

Which is it?
0

LVL 30

Author Comment

ID: 35084517
Then it should be permutations. My bad.

Sid
0

LVL 30

Author Comment

ID: 35084755
Now this confuses me. For example we have 1,2,3 then as per the formula

(n+r-1)! /  (r!(n-1)!)

5! / (3!*2!) = 120/(6*2) = 10

So we are supposed to get 10 permutations or (combination with repetitions) but when I do it manually I get this

111
123
132
222
213
231
333
312
321

Which is just 9. What am I missing?

Sid
0

LVL 19

Expert Comment

ID: 35084765
If, in the example above, you are looking for these combinations :

12, 13, 14, 21 ,22, 23, 24, 31, 32, 33, 34, 41, 42, 43

note : you are actually getting 14 combinations (of two digits, when combining to 3 digits you will have many more possibilities)

you could use this setup (paste in a module and run the start macro)
Option Base 1

Sub start()

Dim list() As Integer
ReDim list(2)
list(1) = 123
list(2) = 234

combine list

End Sub

Sub combine(numbers() As Integer)
Dim r As Integer
Dim c As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim pos As Integer
Dim text As String
Dim base() As String
Dim result() As String
Dim candidate As String

'-- determine length & size of numbers
number_count = UBound(numbers)
number_len = 0
For Each Number In numbers
If Len(Trim(Str(Number))) > number_len Then number_len = Len(Trim(Str(Number)))
Next Number

'-- tear numbers apart
ReDim base(number_count, number_len)
For r = 1 To number_count
For c = 1 To number_len
text = Trim(Str(numbers(r)))
base(r, c) = Mid(text, c, 1)
Next c
Next r

ReDim result(1)
result(1) = base(1, 1) & base(2, 1)

'-- combine digits
For r = 1 To number_count
For c = 1 To number_len
For r2 = 1 To number_count
For c2 = 1 To number_len
'-- do not allow numbers to combine with themselves
If r <> r2 Then
candidate = base(r, c) & base(r2, c2)
'-- check if candidate is already present
invalid = False
For Each Number In result
invalid = (candidate = Number)
If invalid Then Exit For
Next Number
'-- if candidate is valid, add to results
If Not invalid Then
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = candidate
End If
End If
Next c2
Next r2
Next c
Next r

'-- save results to worksheet
ActiveSheet.UsedRange.Delete
For Each Item In result
ActiveSheet.Range("A" & ActiveSheet.UsedRange.Rows.Count + 2) = Item
Next Item

End Sub

0

LVL 30

Author Comment

ID: 35084826
Thanks akoster.

But I wanted for 3 digits and not two digits.

Sid
0

LVL 19

Expert Comment

ID: 35084918
I'm sorry, did not get the right approach.

When combining to 3 digits, I get :

123
122
124
132
133
134
142
143
213
212
214
231
232
233
234
221
223
224
241
243
242
312
313
314
321
322
323
324
331
332
334
341
342
343
412
413
421
423
422
431
432
433
0

LVL 26

Assisted Solution

redmondb earned 50 total points
ID: 35084956
Sid,

Please see attached venerable piece of generic code (not mine, I'm afraid).

On the spreadsheet, I've entered "P" in A1 (or "C" if you prefer combinations), the number of values to be output in A2 (3 in this case) and then the required values in the cells beneath that. Run List_List_Permutations_or_Combinations.

BTW, I also showed an example of Excel's Permut function which calculates the permutation of 6 items, taken a three at a time as 120 - as the macro produces.

Regards,
Brian.
Permutations-or-Combinations.xlsm
0

LVL 19

Accepted Solution

Arno Koster earned 450 total points
ID: 35084967
Sub combine(numbers() As Integer)
Dim r As Integer
Dim c As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim pos As Integer
Dim text As String
Dim base() As String
Dim result() As String
Dim candidate As String

'-- determine length & size of numbers
number_count = UBound(numbers)
number_len = 0
For Each Number In numbers
If Len(Trim(Str(Number))) > number_len Then number_len = Len(Trim(Str(Number)))
Next Number

'-- tear numbers apart
ReDim base(1)
For r = 1 To number_count
For c = 1 To number_len
text = Trim(Str(numbers(r)))
ReDim Preserve base(UBound(base) + 1)
base(UBound(base) - 1) = Mid(text, c, 1)
Next c
Next r
ReDim Preserve base(UBound(base) - 1)

ReDim result(1)
For x = 1 To UBound(base)
For y = 1 To UBound(base)
For Z = 1 To UBound(base)
If x <> y And x <> Z And y <> Z Then
candidate = base(x) & base(y) & base(Z)
'-- check if candidate is already present
invalid = False
For Each Number In result
invalid = (candidate = Number)
If invalid Then Exit For
Next Number
'-- if candidate is valid, add to results
If Not invalid Then
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = candidate
Debug.Print candidate
End If
End If
Next Z
Next y
Next x

'-- save results to worksheet
ActiveSheet.UsedRange.Delete
For Each Item In result
ActiveSheet.Range("A" & ActiveSheet.UsedRange.Rows.Count + 2) = Item
Next Item

End Sub
0

LVL 30

Author Comment

ID: 35085046
Brian: Let me understand it.

akoster: I modified your code to this but I am getting less numbers. I just tried it for 123.

Result I got is

123
132
213
231
312
321

I was expecting this

111
123
132
222
213
231
333
312
321

Sid

Option Base 1

Sub start()
Dim list() As Integer
ReDim list(1)
list(1) = 123
'list(2) = 234
combine list
End Sub

Sub combine(numbers() As Integer)
Dim r As Integer
Dim c As Integer
Dim r2 As Integer
Dim c2 As Integer
Dim pos As Integer
Dim text As String
Dim base() As String
Dim result() As String
Dim candidate As String

'-- determine length & size of numbers
number_count = UBound(numbers)
number_len = 0
For Each Number In numbers
If Len(Trim(Str(Number))) > number_len Then number_len = Len(Trim(Str(Number)))
Next Number

'-- tear numbers apart
ReDim base(1)
For r = 1 To number_count
For c = 1 To number_len
text = Trim(Str(numbers(r)))
ReDim Preserve base(UBound(base) + 1)
base(UBound(base) - 1) = Mid(text, c, 1)
Next c
Next r
ReDim Preserve base(UBound(base) - 1)

ReDim result(1)
For x = 1 To UBound(base)
For y = 1 To UBound(base)
For Z = 1 To UBound(base)
If x <> y And x <> Z And y <> Z Then
candidate = base(x) & base(y) & base(Z)
'-- check if candidate is already present
invalid = False
For Each Number In result
invalid = (candidate = Number)
If invalid Then Exit For
Next Number
'-- if candidate is valid, add to results
If Not invalid Then
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = candidate
Debug.Print candidate
End If
End If
Next Z
Next y
Next x

'-- save results to worksheet
ActiveSheet.UsedRange.Delete
j = 1
For Each Item In result
ActiveSheet.Range("A" & j) = Item
j = j + 1
Next Item
End Sub
0

LVL 19

Expert Comment

ID: 35085059
This code filters out identical numbers, when these are expected as well, comment out lines 34 and 48.
0

LVL 19

Expert Comment

ID: 35085080
apperently it is getting late, the combine subroutine should be started with

Sub start()
Dim list() As Integer
ReDim list(2)
list(1) = 123
list(2) = 234
combine list
End Sub
0

LVL 30

Author Comment

ID: 35085108
akoster: But that is one example. What if I use this?

Sub start()
Dim list() As Integer
ReDim list(1)
list(1) = 123
combine list
End Sub

Sid
0

LVL 30

Author Comment

ID: 35085122
Brian: I checked it. It works but like akoster's code it gives me

123
132
213
231
312
321

I was expecting this

111
123
132
222
213
231
333
312
321

Sid
0

LVL 19

Expert Comment

ID: 35085146
also, note that it relies on input numbers of equal length. In order to combine for example '123' with '23456', update the code to include

[...]
If x <> y And x <> Z And y <> Z Then
If base(x) <> "" And base(y) <> "" And base(Z) <> "" Then
candidate = base(x) & base(y) & base(Z)
[...]

and corresponding end if statements
0

LVL 30

Author Comment

ID: 35085150
Not that will never be the case. It will always be 3 digit numbers.

Sid
0

LVL 19

Expert Comment

ID: 35085158
Sid,

if you also want results like '111', this is not really a permutation of '123' and '234', because there is only one 1 present...
0

LVL 30

Author Comment

ID: 35085177
so basically, I need to incorporate an extra loop to get those kind of number?

Sid
0

LVL 26

Expert Comment

ID: 35085231
Sid,

You're well advanced with akoster so don't bother with this unless that doesn't work out...

Dim arrElements As Variant
Dim arrResult As Variant
Dim p As Long

Sub Run_PermutRep()
Dim lRow As Long

arrElements = Array("1", "2", "2", "3", "3", "4")
p = 3
ReDim arrResult(1 To (UBound(arrElements) - LBound(arrElements) + 1) ^ p, 1 To 1)

PermutRep 1, "", lRow

Application.ScreenUpdating = False

Range("A1").Resize(UBound(arrResult)) = arrResult

Application.ScreenUpdating = True

End Sub

Sub PermutRep(ByVal lInd As Long, ByVal sresult As String, ByRef lRow As Long)
Dim i As Long

For i = LBound(arrElements) To UBound(arrElements)
If lInd = p Then
lRow = lRow + 1
arrResult(lRow, 1) = sresult & arrElements(i)
Else
PermutRep lInd + 1, sresult & arrElements(i), lRow
End If
Next i
End Sub

Regards,
Brian.
0

LVL 19

Expert Comment

ID: 35085316
So in effect you are looking for a way to tear apart numbers into digits, and form all possible 3-digit numbers that are based on the available digits ?

that way, the approach could be
Sub combine(numbers() As Integer)
Dim valid1 As Boolean
Dim valid2 As Boolean
Dim valid3 As Boolean

'-- determine length & size of numbers
number_count = UBound(numbers)
number_len = 0
For Each Number In numbers
If Len(Trim(Str(Number))) > number_len Then number_len = Len(Trim(Str(Number)))
Next Number

'-- tear numbers apart
ReDim base(1)
For r = 1 To number_count
For c = 1 To number_len
text = Trim(Str(numbers(r)))
ReDim Preserve base(UBound(base) + 1)
base(UBound(base) - 1) = Mid(text, c, 1)
Next c
Next r
ReDim Preserve base(UBound(base) - 1)

ReDim result(1)
For candidate = 100 To 999
text = Trim(Str(candidate))

valid1 = False
valid2 = False
valid3 = False

For Each Number In base
valid1 = (Mid(text, 1, 1) = Number)
If valid1 Then Exit For
Next Number

For Each Number In base
valid2 = (Mid(text, 2, 1) = Number)
If valid2 Then Exit For
Next Number

For Each Number In base
valid3 = (Mid(text, 3, 1) = Number)
If valid3 Then Exit For
Next Number

If valid1 And valid2 And valid3 Then
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = candidate
Debug.Print candidate
End If

Next candidate

'-- save results to worksheet
ActiveSheet.UsedRange.Delete
j = 1
For Each Item In result
ActiveSheet.Range("A" & j) = Item
j = j + 1
Next Item
End Sub
0

LVL 19

Expert Comment

ID: 35085325

111
112
113
114
121
122
123
124
131
132
133
134
141
142
143
144
211
212
213
214
221
222
223
224
231
232
233
234
241
242
243
244
311
312
313
314
321
322
323
324
331
332
333
334
341
342
343
344
411
412
413
414
421
422
423
424
431
432
433
434
441
442
443
444
0

LVL 30

Author Closing Comment

ID: 35085438
No I don't need the numbers to be repeated like that. I wanted this

111
123
132
222
213
231
333
312
321

for 123

So I have adapted your code to suit my needs. And I am introducing a loop at the end to give me those extra 3 numbers. Thanks very much. I am sharing 50 points with Brian as well. Hope you don't mind :)

Sid
0

LVL 30

Author Comment

ID: 35085732
akoster: I found a small glitch. If the number starts with a 0 then it gives me an unexpected output.

I was expecting a 083 (see sheet "Tally Sheet").

Sid
random.xlsm
0

LVL 26

Expert Comment

ID: 35085758
Thanks, Sid!
0

LVL 30

Author Comment

ID: 35085804
akoster: Also if you see it generates a 2 digit number.
redmondb: You are welcome :)

Sid
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
When there is a disconnect between the intentions of their creator and the recipient, when algorithms go awry, they can have disastrous consequences.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a â€¦
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
###### Suggested Courses
Course of the Month5 days, 11 hours left to enroll