Hi Tom,

You had given me the below code. I need a little change. Please help me
out one more time.

Now I don't need an input box for m [ m = InputBox("Taken how many at a
time?", "Combinations") ]. It will be 10 (fixed).

There is a difference in the range as well. I have the following
numbers in the range W1:AK19 (please do not change the range let it be
in W1:AK19)

4,9,10,21,35,47,64,72,74,75
4,9,10,21,33,41,47,57,60,72,74
3,4,10,11,21,32,33,35,60,69,74
3,4,7,10,21,33,37,47,57,69,75
4,7,32,37,47,57,60,64,72,74
3,7,10,11,35,47,57,60,64,66,67,72,73,79,80
4,7,9,10,11,32,35,41,69,74
3,4,10,21,32,37,47,64,69,72,75,77
3,7,11,33,35,37,41,47,64,75
4,6,9,10,15,21,31,47,72,74
6,9,13,21,22,31,49,52,63,64,75
9,10,12,21,22,47,49,52,64,72
4,6,9,12,15,35,47,56,63,72
6,9,12,15,21,31,47,64,74,75
6,9,10,13,21,49,52,63,72,74,75,79,80
4,6,13,15,35,56,63,64,74,75
13,15,21,35,47,49,56,63,72,75
4,15,42,45,47,57,60,68,72,74
10,16,28,47,51,52,55,64,71,72,74,75,76,77

I want to create combinations of the first series W1:AF1 =combin(10,1)
then below that I want to create combinations for the second series
W1:AG1 =combin(11,10) and go on listing combinations one below the
other for all the 19 series.

Total combinations should be 4411

I do not want to list these total 4411 combinations on a worksheet, I
want to send it to an array either and towards the end of the code,
just before 'End Sub" I need an input box asking me which combination
to display. If I type 34, it should display 34th element of the array
in the range AM1:AV1

Your code:

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "-" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

Thanx
Maxi

Option Explicit
Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
Dim rng1 As Range, ans As Variant
Dim irw As Long, rw As Range
Dim v1() As Long, i As Long
Dim v2() As Long, cnt As Long
Dim tot As Long, sh As Worksheet
Dim s As String
Set rng1 = Range("W1:AK19")
ReDim v1(1 To rng1.Rows.Count, 2)
i = 0
For Each rw In rng1.Rows
cnt = Application.Count(rw)
i = i + 1
v1(i, 1) = cnt
v1(i, 2) = Application.Combin(cnt, 10)
tot = tot + v1(i, 2)
Next
ReDim v2(1 To tot, 1 To 10)
i = 0
irw = 1
For Each rw In rng1.Rows
i = i + 1
cnt = v1(i, 1)
Set rng = rw.Cells.Resize(1, cnt)
v = Application.Transpose(Application _
.Transpose(rng))
n = cnt 'UBound(v, 1)
m = 10
Comb2 n, m, 1, "'", v, v2, irw
Next
Do
s = ""
ans = Application.InputBox( _
"Enter a number between " & _
"1 and " & tot & ":" & vbNewLine & _
"(Hit cancel to quit)", _
"Show Combinations", tot, _
Type:=1)
If ans = False Then Exit Do
If ans = 1 And ans <= tot Then
For i = 1 To m
s = s & v2(ans, i) & ","
Next
s = Left(s, Len(s) - 1)
MsgBox "For row " & ans & " combinations" & _
" a " & vbNewLine & vbNewLine & s
Else
MsgBox "Row " & ans & "doesn't exits"
End If
Loop
'
' Uncomment the next 3 lines if you want a new sheet with
' all the combinations listed on it (for validation purposes)
'
' Worksheets.Add After:=Worksheets(Worksheets.Count)
' Set sh = ActiveSheet
' sh.Range("A1").Resize(tot, 10).Value = v2
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant, _
v2() As Long, irw As Long)
Dim v1 As Variant, i As Long
If m n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
v2(irw, i + 1) = v(v1(i))
Next
irw = irw + 1
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v, v2, irw
Comb2 n, m, k + 1, s, v, v2, irw
End Sub

--
Regards,
Tom Ogilvy


"Maxi" wrote:

Hi Tom,

You had given me the below code. I need a little change. Please help me
out one more time.

Now I don't need an input box for m [ m = InputBox("Taken how many at a
time?", "Combinations") ]. It will be 10 (fixed).

There is a difference in the range as well. I have the following
numbers in the range W1:AK19 (please do not change the range let it be
in W1:AK19)

4,9,10,21,35,47,64,72,74,75
4,9,10,21,33,41,47,57,60,72,74
3,4,10,11,21,32,33,35,60,69,74
3,4,7,10,21,33,37,47,57,69,75
4,7,32,37,47,57,60,64,72,74
3,7,10,11,35,47,57,60,64,66,67,72,73,79,80
4,7,9,10,11,32,35,41,69,74
3,4,10,21,32,37,47,64,69,72,75,77
3,7,11,33,35,37,41,47,64,75
4,6,9,10,15,21,31,47,72,74
6,9,13,21,22,31,49,52,63,64,75
9,10,12,21,22,47,49,52,64,72
4,6,9,12,15,35,47,56,63,72
6,9,12,15,21,31,47,64,74,75
6,9,10,13,21,49,52,63,72,74,75,79,80
4,6,13,15,35,56,63,64,74,75
13,15,21,35,47,49,56,63,72,75
4,15,42,45,47,57,60,68,72,74
10,16,28,47,51,52,55,64,71,72,74,75,76,77

I want to create combinations of the first series W1:AF1 =combin(10,1)
then below that I want to create combinations for the second series
W1:AG1 =combin(11,10) and go on listing combinations one below the
other for all the 19 series.

Total combinations should be 4411

I do not want to list these total 4411 combinations on a worksheet, I
want to send it to an array either and towards the end of the code,
just before 'End Sub" I need an input box asking me which combination
to display. If I type 34, it should display 34th element of the array
in the range AM1:AV1

Your code:

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "-" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

Thanx
Maxi

I need little bit of calculation/validation within the array. Check for
duplicate entries within the array and find out which element of the
array is repeated the highest number of times. I want to keep only
those elements which are repeated the highest number of times and
(highest -1) in the array and remove all other elements.

For example:
If there are elements which is repeated 4 times, then keep those
elements and also keep those which are repeated 3 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 7 times, then keep those
elements and also keep those which are repeated 6 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 2 times, then keep all elements
in the array and do not remove anything.

In my example, you might not get any duplicates, you might have to
change some data in the range W1:AK19 so that few duplicate entries
goes into the array.

Thanks
Maxi

Tom Ogilvy wrote:
Option Explicit
Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
Dim rng1 As Range, ans As Variant
Dim irw As Long, rw As Range
Dim v1() As Long, i As Long
Dim v2() As Long, cnt As Long
Dim tot As Long, sh As Worksheet
Dim s As String
Set rng1 = Range("W1:AK19")
ReDim v1(1 To rng1.Rows.Count, 2)
i = 0
For Each rw In rng1.Rows
cnt = Application.Count(rw)
i = i + 1
v1(i, 1) = cnt
v1(i, 2) = Application.Combin(cnt, 10)
tot = tot + v1(i, 2)
Next
ReDim v2(1 To tot, 1 To 10)
i = 0
irw = 1
For Each rw In rng1.Rows
i = i + 1
cnt = v1(i, 1)
Set rng = rw.Cells.Resize(1, cnt)
v = Application.Transpose(Application _
.Transpose(rng))
n = cnt 'UBound(v, 1)
m = 10
Comb2 n, m, 1, "'", v, v2, irw
Next
Do
s = ""
ans = Application.InputBox( _
"Enter a number between " & _
"1 and " & tot & ":" & vbNewLine & _
"(Hit cancel to quit)", _
"Show Combinations", tot, _
Type:=1)
If ans = False Then Exit Do
If ans = 1 And ans <= tot Then
For i = 1 To m
s = s & v2(ans, i) & ","
Next
s = Left(s, Len(s) - 1)
MsgBox "For row " & ans & " combinations" & _
" a " & vbNewLine & vbNewLine & s
Else
MsgBox "Row " & ans & "doesn't exits"
End If
Loop
'
' Uncomment the next 3 lines if you want a new sheet with
' all the combinations listed on it (for validation purposes)
'
' Worksheets.Add After:=Worksheets(Worksheets.Count)
' Set sh = ActiveSheet
' sh.Range("A1").Resize(tot, 10).Value = v2
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant, _
v2() As Long, irw As Long)
Dim v1 As Variant, i As Long
If m n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
v2(irw, i + 1) = v(v1(i))
Next
irw = irw + 1
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v, v2, irw
Comb2 n, m, k + 1, s, v, v2, irw
End Sub

--
Regards,
Tom Ogilvy


"Maxi" wrote:

Hi Tom,

You had given me the below code. I need a little change. Please help me
out one more time.

Now I don't need an input box for m [ m = InputBox("Taken how many at a
time?", "Combinations") ]. It will be 10 (fixed).

There is a difference in the range as well. I have the following
numbers in the range W1:AK19 (please do not change the range let it be
in W1:AK19)

4,9,10,21,35,47,64,72,74,75
4,9,10,21,33,41,47,57,60,72,74
3,4,10,11,21,32,33,35,60,69,74
3,4,7,10,21,33,37,47,57,69,75
4,7,32,37,47,57,60,64,72,74
3,7,10,11,35,47,57,60,64,66,67,72,73,79,80
4,7,9,10,11,32,35,41,69,74
3,4,10,21,32,37,47,64,69,72,75,77
3,7,11,33,35,37,41,47,64,75
4,6,9,10,15,21,31,47,72,74
6,9,13,21,22,31,49,52,63,64,75
9,10,12,21,22,47,49,52,64,72
4,6,9,12,15,35,47,56,63,72
6,9,12,15,21,31,47,64,74,75
6,9,10,13,21,49,52,63,72,74,75,79,80
4,6,13,15,35,56,63,64,74,75
13,15,21,35,47,49,56,63,72,75
4,15,42,45,47,57,60,68,72,74
10,16,28,47,51,52,55,64,71,72,74,75,76,77

I want to create combinations of the first series W1:AF1 =combin(10,1)
then below that I want to create combinations for the second series
W1:AG1 =combin(11,10) and go on listing combinations one below the
other for all the 19 series.

Total combinations should be 4411

I do not want to list these total 4411 combinations on a worksheet, I
want to send it to an array either and towards the end of the code,
just before 'End Sub" I need an input box asking me which combination
to display. If I type 34, it should display 34th element of the array
in the range AM1:AV1

Your code:

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "-" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

Thanx
Maxi

Define "in the array"

The array has 4411 x 10 elements.

Are you talking about entire rows being repeated?

Are you talking about elements repeating in each single row?

Need a better definition of what you are looking for.

--
Regards,
Tom Ogilvy


"Maxi" wrote in message
oups.com...
I need little bit of calculation/validation within the array. Check for
duplicate entries within the array and find out which element of the
array is repeated the highest number of times. I want to keep only
those elements which are repeated the highest number of times and
(highest -1) in the array and remove all other elements.

For example:
If there are elements which is repeated 4 times, then keep those
elements and also keep those which are repeated 3 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 7 times, then keep those
elements and also keep those which are repeated 6 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 2 times, then keep all elements
in the array and do not remove anything.

In my example, you might not get any duplicates, you might have to
change some data in the range W1:AK19 so that few duplicate entries
goes into the array.

Thanks
Maxi

Tom Ogilvy wrote:
Option Explicit
Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
Dim rng1 As Range, ans As Variant
Dim irw As Long, rw As Range
Dim v1() As Long, i As Long
Dim v2() As Long, cnt As Long
Dim tot As Long, sh As Worksheet
Dim s As String
Set rng1 = Range("W1:AK19")
ReDim v1(1 To rng1.Rows.Count, 2)
i = 0
For Each rw In rng1.Rows
cnt = Application.Count(rw)
i = i + 1
v1(i, 1) = cnt
v1(i, 2) = Application.Combin(cnt, 10)
tot = tot + v1(i, 2)
Next
ReDim v2(1 To tot, 1 To 10)
i = 0
irw = 1
For Each rw In rng1.Rows
i = i + 1
cnt = v1(i, 1)
Set rng = rw.Cells.Resize(1, cnt)
v = Application.Transpose(Application _
.Transpose(rng))
n = cnt 'UBound(v, 1)
m = 10
Comb2 n, m, 1, "'", v, v2, irw
Next
Do
s = ""
ans = Application.InputBox( _
"Enter a number between " & _
"1 and " & tot & ":" & vbNewLine & _
"(Hit cancel to quit)", _
"Show Combinations", tot, _
Type:=1)
If ans = False Then Exit Do
If ans = 1 And ans <= tot Then
For i = 1 To m
s = s & v2(ans, i) & ","
Next
s = Left(s, Len(s) - 1)
MsgBox "For row " & ans & " combinations" & _
" a " & vbNewLine & vbNewLine & s
Else
MsgBox "Row " & ans & "doesn't exits"
End If
Loop
'
' Uncomment the next 3 lines if you want a new sheet with
' all the combinations listed on it (for validation purposes)
'
' Worksheets.Add After:=Worksheets(Worksheets.Count)
' Set sh = ActiveSheet
' sh.Range("A1").Resize(tot, 10).Value = v2
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant, _
v2() As Long, irw As Long)
Dim v1 As Variant, i As Long
If m n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
v2(irw, i + 1) = v(v1(i))
Next
irw = irw + 1
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v, v2, irw
Comb2 n, m, k + 1, s, v, v2, irw
End Sub

--
Regards,
Tom Ogilvy


"Maxi" wrote:

Hi Tom,

You had given me the below code. I need a little change. Please help me
out one more time.

Now I don't need an input box for m [ m = InputBox("Taken how many at a
time?", "Combinations") ]. It will be 10 (fixed).

There is a difference in the range as well. I have the following
numbers in the range W1:AK19 (please do not change the range let it be
in W1:AK19)

4,9,10,21,35,47,64,72,74,75
4,9,10,21,33,41,47,57,60,72,74
3,4,10,11,21,32,33,35,60,69,74
3,4,7,10,21,33,37,47,57,69,75
4,7,32,37,47,57,60,64,72,74
3,7,10,11,35,47,57,60,64,66,67,72,73,79,80
4,7,9,10,11,32,35,41,69,74
3,4,10,21,32,37,47,64,69,72,75,77
3,7,11,33,35,37,41,47,64,75
4,6,9,10,15,21,31,47,72,74
6,9,13,21,22,31,49,52,63,64,75
9,10,12,21,22,47,49,52,64,72
4,6,9,12,15,35,47,56,63,72
6,9,12,15,21,31,47,64,74,75
6,9,10,13,21,49,52,63,72,74,75,79,80
4,6,13,15,35,56,63,64,74,75
13,15,21,35,47,49,56,63,72,75
4,15,42,45,47,57,60,68,72,74
10,16,28,47,51,52,55,64,71,72,74,75,76,77

I want to create combinations of the first series W1:AF1 =combin(10,1)
then below that I want to create combinations for the second series
W1:AG1 =combin(11,10) and go on listing combinations one below the
other for all the 19 series.

Total combinations should be 4411

I do not want to list these total 4411 combinations on a worksheet, I
want to send it to an array either and towards the end of the code,
just before 'End Sub" I need an input box asking me which combination
to display. If I type 34, it should display 34th element of the array
in the range AM1:AV1

Your code:

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "-" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

Thanx
Maxi

Sorry about the confusion. I mean 1 X 10 being repeated (the entire
row).

eg.
1,2,3,4,5,6,7,8,9,10
1,2,3,4,5,6,7,8,9,11
1,2,3,4,5,6,7,8,9,10
1,2,3,4,5,6,7,8,9,12
1,2,3,4,5,6,7,8,9,10

1,2,3,4,5,6,7,8,9,10 : repeated thrice

Tom Ogilvy wrote:
Define "in the array"

The array has 4411 x 10 elements.

Are you talking about entire rows being repeated?

Are you talking about elements repeating in each single row?

Need a better definition of what you are looking for.

--
Regards,
Tom Ogilvy


"Maxi" wrote in message
oups.com...
I need little bit of calculation/validation within the array. Check for
duplicate entries within the array and find out which element of the
array is repeated the highest number of times. I want to keep only
those elements which are repeated the highest number of times and
(highest -1) in the array and remove all other elements.

For example:
If there are elements which is repeated 4 times, then keep those
elements and also keep those which are repeated 3 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 7 times, then keep those
elements and also keep those which are repeated 6 times (highest -1)
and remove all other elements from the array.

If there are elements which is repeated 2 times, then keep all elements
in the array and do not remove anything.

In my example, you might not get any duplicates, you might have to
change some data in the range W1:AK19 so that few duplicate entries
goes into the array.

Thanks
Maxi

Tom Ogilvy wrote:
Option Explicit
Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
Dim rng1 As Range, ans As Variant
Dim irw As Long, rw As Range
Dim v1() As Long, i As Long
Dim v2() As Long, cnt As Long
Dim tot As Long, sh As Worksheet
Dim s As String
Set rng1 = Range("W1:AK19")
ReDim v1(1 To rng1.Rows.Count, 2)
i = 0
For Each rw In rng1.Rows
cnt = Application.Count(rw)
i = i + 1
v1(i, 1) = cnt
v1(i, 2) = Application.Combin(cnt, 10)
tot = tot + v1(i, 2)
Next
ReDim v2(1 To tot, 1 To 10)
i = 0
irw = 1
For Each rw In rng1.Rows
i = i + 1
cnt = v1(i, 1)
Set rng = rw.Cells.Resize(1, cnt)
v = Application.Transpose(Application _
.Transpose(rng))
n = cnt 'UBound(v, 1)
m = 10
Comb2 n, m, 1, "'", v, v2, irw
Next
Do
s = ""
ans = Application.InputBox( _
"Enter a number between " & _
"1 and " & tot & ":" & vbNewLine & _
"(Hit cancel to quit)", _
"Show Combinations", tot, _
Type:=1)
If ans = False Then Exit Do
If ans = 1 And ans <= tot Then
For i = 1 To m
s = s & v2(ans, i) & ","
Next
s = Left(s, Len(s) - 1)
MsgBox "For row " & ans & " combinations" & _
" a " & vbNewLine & vbNewLine & s
Else
MsgBox "Row " & ans & "doesn't exits"
End If
Loop
'
' Uncomment the next 3 lines if you want a new sheet with
' all the combinations listed on it (for validation purposes)
'
' Worksheets.Add After:=Worksheets(Worksheets.Count)
' Set sh = ActiveSheet
' sh.Range("A1").Resize(tot, 10).Value = v2
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant, _
v2() As Long, irw As Long)
Dim v1 As Variant, i As Long
If m n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
v2(irw, i + 1) = v(v1(i))
Next
irw = irw + 1
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v, v2, irw
Comb2 n, m, k + 1, s, v, v2, irw
End Sub

--
Regards,
Tom Ogilvy


"Maxi" wrote:

Hi Tom,

You had given me the below code. I need a little change. Please help me
out one more time.

Now I don't need an input box for m [ m = InputBox("Taken how many at a
time?", "Combinations") ]. It will be 10 (fixed).

There is a difference in the range as well. I have the following
numbers in the range W1:AK19 (please do not change the range let it be
in W1:AK19)

4,9,10,21,35,47,64,72,74,75
4,9,10,21,33,41,47,57,60,72,74
3,4,10,11,21,32,33,35,60,69,74
3,4,7,10,21,33,37,47,57,69,75
4,7,32,37,47,57,60,64,72,74
3,7,10,11,35,47,57,60,64,66,67,72,73,79,80
4,7,9,10,11,32,35,41,69,74
3,4,10,21,32,37,47,64,69,72,75,77
3,7,11,33,35,37,41,47,64,75
4,6,9,10,15,21,31,47,72,74
6,9,13,21,22,31,49,52,63,64,75
9,10,12,21,22,47,49,52,64,72
4,6,9,12,15,35,47,56,63,72
6,9,12,15,21,31,47,64,74,75
6,9,10,13,21,49,52,63,72,74,75,79,80
4,6,13,15,35,56,63,64,74,75
13,15,21,35,47,49,56,63,72,75
4,15,42,45,47,57,60,68,72,74
10,16,28,47,51,52,55,64,71,72,74,75,76,77

I want to create combinations of the first series W1:AF1 =combin(10,1)
then below that I want to create combinations for the second series
W1:AG1 =combin(11,10) and go on listing combinations one below the
other for all the 19 series.

Total combinations should be 4411

I do not want to list these total 4411 combinations on a worksheet, I
want to send it to an array either and towards the end of the code,
just before 'End Sub" I need an input box asking me which combination
to display. If I type 34, it should display 34th element of the array
in the range AM1:AV1

Your code:

Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
numcomb = 0
Set rng = Range("A1:T1")
'Set rng = rng.Resize(1, 5)
v = Application.Transpose(Application _
.Transpose(rng))
n = UBound(v, 1)
m = InputBox("Taken how many at a time?", "Combinations")
If Application.Combin(n, m) 64530 Then
MsgBox "Too many to write out, quitting"
Exit Sub
End If
Range("A3").Select
Comb2 n, m, 1, "'", v
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant)
Dim v1 As Variant
If m n - k + 1 Then Exit Sub
If m = 0 Then
'Debug.Print "-" & s & "<-"
v1 = Split(Replace(Trim(s), "'", ""), " ")
For i = LBound(v1) To UBound(v1)
ActiveCell.Offset(0, i) = v(v1(i))
Next
ActiveCell.Offset(1, 0).Select
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v
Comb2 n, m, k + 1, s, v
End Sub

Thanx
Maxi

this is an intermediate result. on the added sheet, you will see your 4411
rows with each combination in columnA (each value occupies 3 digits - so 30
digits. This list is sorted
Column B holds the index location from the original array
Column C holds the a sequence counter for matches. the first record in a
matching sequence will have a 1, the second a 2 and so forth
Column D will show the max value in that sequence. So for 6 matching rows,
for the first row, column C: 1, column D: 6; for the second matching row
Column C: 2, Column D: 6 until both column C and D contain 6.

Column F, starting in row 1 is numbered 1 to the highest number of
duplicates
Column G corresponds to F and lists the number of duplicate sets for the
number in F on the same row

Column I has Column A repeated except the rows that don't have the maximum
or the maximum -1 in the set are blank
Column J is the same as Column B, so you have an index into the original
array


If the max number is 3 of duplicates is 3, assume that any sets with 2
duplicates would be retained

If there are m number of unique combinations that have the maximum number of
duplicates and m1 number of unique combinations that have the (maximum - 1)
number of duplicates, are these all left and everything else cleared?

So what now. How do you want it packaged.
leave it in the array. Should the original array be compressed down so
there are no empty rows?

Just for info, I did 266 rows (duplicating a modified version of your data
of 19 rows) and generated a 61K x 10 array of combinations. This processed
in less than 10 seconds on my machine.


Option Explicit
Sub Combinations()
Dim n As Integer, m As Integer
Dim v As Variant, rng As Range
Dim rng1 As Range, ans As Variant
Dim irw As Long, rw As Range
Dim v1() As Long, i As Long
Dim v2() As Long, cnt As Long
Dim v3() As Variant, lMax As Long
Dim v4() As Long
Dim tot As Long, sh As Worksheet
Dim s As String, bAscending As Boolean
'Set rng1 = Range("W1:AK19")
Set rng1 = Range("W1:AK38")
ReDim v1(1 To rng1.Rows.Count, 2)
i = 0
For Each rw In rng1.Rows
cnt = Application.Count(rw)
i = i + 1
v1(i, 1) = cnt
v1(i, 2) = Application.Combin(cnt, 10)
tot = tot + v1(i, 2)
Next
ReDim v2(1 To tot, 1 To 10)
ReDim v3(1 To tot, 1 To 5)
i = 0
irw = 1
For Each rw In rng1.Rows
i = i + 1
cnt = v1(i, 1)
Set rng = rw.Cells.Resize(1, cnt)
v = Application.Transpose(Application _
.Transpose(rng))
n = cnt 'UBound(v, 1)
m = 10
Comb2 n, m, 1, "'", v, v2, v3, irw
Next
Do
s = ""
ans = Application.InputBox( _
"Enter a number between " & _
"1 and " & tot & ":" & vbNewLine & _
"(Hit cancel to quit)", _
"Show Combinations", tot, _
Type:=1)
If ans = False Then Exit Do
If ans = 1 And ans <= tot Then
For i = 1 To m
s = s & v2(ans, i) & ","
Next
s = Left(s, Len(s) - 1)
MsgBox "For row " & ans & " combinations" & _
" a " & vbNewLine & vbNewLine & s
Else
MsgBox "Row " & ans & "doesn't exits"
End If
Loop
'
' Uncomment the next 3 lines if you want a new sheet with
' all the combinations listed on it (for validation purposes)
'
bAscending = True
QuickSort v3, 1, LBound(v3, 1), UBound(v3, 1), bAscending
lMax = 1
v3(1, 3) = 1
For i = 2 To UBound(v3, 1)
If StrComp(v3(i, 1), v3(i - 1, 1), vbBinaryCompare) 0 Then
v3(i, 3) = 1
Else
v3(i, 3) = v3(i - 1, 3) + 1
End If
If v3(i, 3) lMax Then lMax = v3(i, 3)
Next
ReDim v4(1 To lMax)

v3(UBound(v3, 1), 4) = v3(UBound(v3, 1), 3)
v4(v3(UBound(v3, 1), 4)) = 1

For i = UBound(v3, 1) - 1 To 1 Step -1
If v3(i, 3) < v3(i + 1, 3) Then
v3(i, 4) = v3(i + 1, 4)
Else
v3(i, 4) = v3(i, 3)
v4(v3(i, 4)) = v4(v3(i, 4)) + 1
End If
Next
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set sh = ActiveSheet
' sh.Range("A1").Resize(tot, 10).Value = v2
sh.Range("A1").Resize(tot, 5).Value = v3
sh.Range("G1").Resize(lMax, 1).Value = _
Application.Transpose(v4)
For i = 1 To lMax
sh.Cells(i, "F").Value = i
Next
If lMax 2 Then
For i = 1 To tot
If v3(i, 4) < lMax And v3(i, 4) < lMax - 1 Then
v3(i, 1) = Empty
End If
Next
sh.Range("I1").Resize(tot, 5).Value = v3
sh.Columns(11).Resize(, 3).Delete
If IsEmpty(sh.Range("I1")) Then sh.Range("I1").End(xlDown).Select
End If
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Sub Comb2(ByVal n As Integer, ByVal m As Integer, _
ByVal k As Integer, ByVal s As String, v As Variant, _
v2() As Long, v3() As Variant, irw As Long)
Dim v1 As Variant, i As Long, s1 As String
If m n - k + 1 Then Exit Sub
If m = 0 Then
v1 = Split(Replace(Trim(s), "'", ""), " ")
s1 = "'"
For i = LBound(v1) To UBound(v1)
v2(irw, i + 1) = v(v1(i))
s1 = s1 & Format(v(v1(i)), "000")
Next
v3(irw, 1) = s1
v3(irw, 2) = irw
irw = irw + 1
Exit Sub
End If
Comb2 n, m - 1, k + 1, s & k & " ", v, v2, v3, irw
Comb2 n, m, k + 1, s, v, v2, v3, irw
End Sub


Sub QuickSort(SortArray, col, L, R, bAscending)
'
'Originally Posted by Jim Rech 10/20/98 Excel.Programming
'Modified to sort on first column of a two dimensional array
'Modified to handle a second dimension greater than 1 (or zero)
'Modified to sort on a specified column in a 2D array
'Modified to do Ascending or Descending
Dim i, j, X, Y, mm

i = L
j = R
X = SortArray((L + R) / 2, col)
If bAscending Then
While (i <= j)
While (SortArray(i, col) < X And i < R)
i = i + 1
Wend
While (X < SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
Else
While (i <= j)
While (SortArray(i, col) X And i < R)
i = i + 1
Wend
While (X SortArray(j, col) And j L)
j = j - 1
Wend
If (i <= j) Then
For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
Y = SortArray(i, mm)
SortArray(i, mm) = SortArray(j, mm)
SortArray(j, mm) = Y
Next mm
i = i + 1
j = j - 1
End If
Wend
End If
If (L < j) Then Call QuickSort(SortArray, col, L, j, bAscending)
If (i < R) Then Call QuickSort(SortArray, col, i, R, bAscending)
End Sub

--
Regards,
Tom Ogilvy