Is it OK if a "non-guy" answers your question <g ?

Since your numbers will range from 1 to 34, in a 50 cell range there must be either blanks or
duplicates. With 34 different numbers, you will get 561 pairs (01-02 to 33-34), 5984 triplets
(01-02-03 to 32-33-34), and 46,376 quadruplets (01-02-03-04 to 31-32-33-34).

The macro generates the sets as a single number. The appearance of 2, 3, or 4 numbers is
achieved by formatting, so there are leading zeroes for numbers 1 through 9.

I'm curious: what is the purpose of all of this? Is this some kind of gambling problem?


Option Explicit

Sub GetCombos()
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim n1 As Long
Dim n2 As Long
Dim n3 As Long
Dim n4 As Long
Dim Rng As Range
Dim v As Variant
Dim Singles() As Double
Dim Pairs() As Double
Dim Triples() As Double
Dim Quads() As Double

Const Multiplier As Long = 100

Set Rng = Range("A1:E10")
ReDim Singles(1 To Rng.Cells.Count)

'get the unique numbers from the range into Singles()
n1 = 0
For i = 1 To Rng.Cells.Count
v = Rng.Cells(i).Value
If IsEmpty(v) Then
'skip this cell
ElseIf IsNumeric(v) Then
'MATCH will give an error if it's a new number
If IsError(Application.Match(v, Singles(), 0)) Then
n1 = n1 + 1
Singles(n1) = v
End If
End If
Next i

ReDim Preserve Singles(1 To n1) 'max is 34

i = Application.Combin(n1, 2) 'max is 561
ReDim Pairs(1 To i, 1 To 1)

i = Application.Combin(n1, 3) 'max is 5984
ReDim Triples(1 To i, 1 To 1)

i = Application.Combin(n1, 4)
ReDim Quads(1 To i, 1 To 1) 'max is 46,376

n2 = 0
n3 = 0
n4 = 0

For i = 1 To n1
For j = i + 1 To n1
n2 = n2 + 1
Pairs(n2, 1) = Singles(i) * Multiplier + Singles(j)

For k = j + 1 To n1
n3 = n3 + 1
Triples(n3, 1) = Pairs(n2, 1) * Multiplier + Singles(k)

For m = k + 1 To n1
n4 = n4 + 1
Quads(n4, 1) = Triples(n3, 1) * Multiplier + Singles(m)
Next m
Next k
Next j
Next i

Range("G1:I1").Value = Array("Pairs", "Triples", "4's")

With Range("G2").Resize(n2)
.Value = Pairs()
.NumberFormat = "00-00"
End With

With Range("H2").Resize(n3)
.Value = Triples()
.NumberFormat = "00-00-00"
End With

With Range("I2").Resize(n4)
.Value = Quads()
.NumberFormat = "00-00-00-00"
End With
End Sub



On 30 Jul 2003 12:36:29 -0700, (ste mac) wrote:

Hi Guys, l am new to this news group and was hoping somebody could
help me out with some macro code...
Picture the scene, l have in column A (rows 1 thru 10)a set of
ascending numbers upto a maximum of 10 digits (there could be only 6,
or 8 or 9 etc)...
then the same in column B and C and D and finally E...so it looks
something like this:

ColA Col B Col C Col D Col E Ex: generated pairs triples
quads
f
There can be as many as 10 digits in any column and as low a 5
digits...
now, what l would really like to do is list all the unique 'pairs' of
digits that could be produced by all the digits in the range i.e
1-2...1-3...1-4 etc all the way up to 33-34... if this is not hard
enough on its own, l need the triples! i.e 1-2-3...1-2-4...1-2-5 etc
and to make matters even tougher l really need to quads to finish it
off (oh no!!)yep! i.e 1-2-3-4...1-2-3-5... 1-2-3-6...1-18-19-32 etc
etc...
l know that quads alone will produce something in the region of 15 to
20,000 records...so even though l am asking a lot, l would like the
results to be generated down a single column for the 'pairs' and
another for the 'triples' and finally one for the 'quads'...
l have to change the values in the columns once they have all been
generated to run the process again with a different set of numbers in
the columns, also l need something inbetween the generated numbers ie
a "-"...The numbers in the columns will be from 1(min) to 34(max)...
tough one? (nightmare!)

Thanks in advance for any help gratefully recieved...

seeya ste