ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   one doozie of a macro req'd please... (https://www.excelbanter.com/excel-programming/273165-re-one-doozie-macro-reqd-please.html)

Myrna Larson[_2_]

one doozie of a macro req'd please...
 
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



Alan Beban[_3_]

one doozie of a macro req'd please...
 
C'mon, Myrna. Some of us--even some of your vintage and even somewhat
older <g--think "guy" is currently a non-gender-specific generic term.
So yes, you should feel included.

Alan Beban

Myrna Larson wrote:
Is it OK if a "non-guy" answers your question <g ? [snip]



ste mac

one doozie of a macro req'd please...
 
Myrna, I am more than pleased that a "non-guy" answered my question,
the macro you have written is perfect! all I can say is thankyou very
much...
You are right to assume that this was part lotto problem, it is just
something I mess around with in my spare time...but as I am no VB
expert and some code is just too difficult to write without the help
of you "non guys" and of course real guys he he he he...
once again thankyou...


seeya ste

Myrna Larson[_2_]

one doozie of a macro req'd please...
 
If you win "big-time", you'll remember where you got the help, won't you <vbg?

On 31 Jul 2003 02:41:34 -0700, (ste mac) wrote:

Myrna, I am more than pleased that a "non-guy" answered my question,
the macro you have written is perfect! all I can say is thankyou very
much...
You are right to assume that this was part lotto problem, it is just
something I mess around with in my spare time...but as I am no VB
expert and some code is just too difficult to write without the help
of you "non guys" and of course real guys he he he he...
once again thankyou...


seeya ste



ste mac

one doozie of a macro req'd please...
 
You can bet on it Myrna....cheers...


All times are GMT +1. The time now is 10:39 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com