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

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

Few you missed.

221, 331 etc...

Sid

221, 331 etc...

Sid

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?

If order matters, you are doing PERMUTATIONS.

Which is it?

Then it should be permutations. My bad.

Sid

Sid

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

(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

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)

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
```

Thanks akoster.

But I wanted for 3 digits and not two digits.

Sid

But I wanted for 3 digits and not two digits.

Sid

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

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

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.

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.

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

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
```

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

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

Sub start()

Dim list() As Integer

ReDim list(2)

list(1) = 123

list(2) = 234

combine list

End Sub

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

Sub start()

Dim list() As Integer

ReDim list(1)

list(1) = 123

combine list

End Sub

Sid

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

123

132

213

231

312

321

I was expecting this

111

123

132

222

213

231

333

312

321

Sid

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

and corresponding end if statements

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

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

Sid

Sid

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

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

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

Sid

Sid

Sid,

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

Regards,

Brian.

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
```

Regards,

Brian.

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

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
```

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

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

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

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

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

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

Sid

Thanks, Sid!

akoster: Also if you see it generates a 2 digit number.

redmondb: You are welcome :)

Sid

redmondb: You are welcome :)

Sid

Open in new window