Avatar of SiddharthRout
SiddharthRout
Flag for India asked on

Combination Generator

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
Microsoft ExcelAlgorithmsMath / Science

Avatar of undefined
Last Comment
SiddharthRout

8/22/2022 - Mon
d-glitch


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.

Open in new window

SiddharthRout

ASKER
Few you missed.

221, 331 etc...

Sid
d-glitch

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?
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
SiddharthRout

ASKER
Then it should be permutations. My bad.

Sid
SiddharthRout

ASKER
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
Arno Koster

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
    
    '-- start with first result
    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

Open in new window





⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
SiddharthRout

ASKER
Thanks akoster.

But I wanted for 3 digits and not two digits.

Sid
Arno Koster

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
SOLUTION
redmondb

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
ASKER CERTIFIED SOLUTION
Arno Koster

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
SiddharthRout

ASKER
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

Open in new window

Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
Arno Koster

This code filters out identical numbers, when these are expected as well, comment out lines 34 and 48.
Arno Koster

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
SiddharthRout

ASKER
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
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
SiddharthRout

ASKER
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
Arno Koster

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)
[...]

Open in new window


and corresponding end if statements
SiddharthRout

ASKER
Not that will never be the case. It will always be 3 digit numbers.

Sid
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Arno Koster

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...
SiddharthRout

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

Sid
redmondb

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()
'http://www.mrexcel.com/forum/showthread.php?t=436932
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

Sheets.Add
 
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)
'http://www.mrexcel.com/forum/showthread.php?t=436932
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

Open in new window


Regards,
Brian.
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Arno Koster

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

Open in new window

Arno Koster

this would lead to

 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
SiddharthRout

ASKER
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
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
SiddharthRout

ASKER
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
redmondb

Thanks, Sid!
SiddharthRout

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

Sid
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.