ExcelBanter - Generations Code Help

Michael

Try this

Sub Jackpot()

Dim Rng As Range
Dim NumCount() As Long
Dim Rndm As Long
Dim Jckpt As String
Dim NoDupes As String

'Set the range that contains the number
Set Rng = Sheet1.Range("a1:d5")

'Make the array big enough
ReDim NumCount(1 To Rng.Columns.Count)

'Start the loop
Do
'Choose a random number
Randomize
Rndm = Int((Rnd * Rng.Cells.Count) + 1)

'See if that number has been chosen already
If InStr(1, NoDupes, Rng.Cells(Rndm).Address) = 0 Then

'Test the number taken from each column
If TestRand(Rndm, NumCount, Rng.Cells(Rndm).Column) Then

'Increase the count of numbers for the column
NumCount(Rng.Cells(Rndm).Column) = _
NumCount(Rng.Cells(Rndm).Column) + 1

'Build a string containing valid numbers
Jckpt = Jckpt & Rng.Cells(Rndm).Value & " - "

'Add the address to NoDupes to prevent that
'number from being chosen again
NoDupes = NoDupes & Rng.Cells(Rndm).Address
End If
End If
'Stop the loop when there are six numbers
Loop Until Len(Jckpt) - Len(Replace(Jckpt, "-", "")) = 6

'Remove the last hyphen
Jckpt = Left(Jckpt, Len(Jckpt) - 3)

'show the number
MsgBox Jckpt

End Sub

Function TestRand(tRnd As Long, tNumCount As Variant, _
tCol As Long) As Boolean

Dim i As Long
Dim TwoCnt As Long

TestRand = False

'Count the columns that have two numbers chosen
For i = LBound(tNumCount) To UBound(tNumCount)
If tNumCount(i) = 2 Then
TwoCnt = TwoCnt + 1
End If
Next i

'If two columns have two numbers chosen
If TwoCnt = 2 Then
'Only accept numbers from columns with no numbers chosen
If tNumCount(tCol) < 1 Then
TestRand = True
End If
Else
'Only accept numbers from columns with less than two
'numbers chosen
If tNumCount(tCol) < 2 Then
TestRand = True
End If
End If

End Function

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Michael168" wrote in message
...
Hello everybody

Is there anyone can help me to code the module?

I have 4 columns of data (A:D) . Each column contains 5 rows (1-5).Each
column contain 1 unique nos.
This is for generating Jackpot combinations, i.e. 6 numbers in a
group.
The condition is that the group generated must contain two pair numbers
from column A:D and two single numbers from column A:D.
In another word the maximum numbers can get from each column is 2
numbers and the minimun number is 1 number.
The combinations must come from 4 columns.

------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~ View and post usenet messages directly from http://www.ExcelForum.com/