Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Generations Code Help

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/

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 179
Default 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/



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
Code to conditional format all black after date specified in code? wx4usa Excel Discussion (Misc queries) 3 December 26th 08 07:06 PM
Free social world wide network pays for 10 generations! Free! alabatros1 Excel Discussion (Misc queries) 0 November 15th 08 09:52 PM
Drop Down/List w/Code and Definition, only code entered when selec Spiritdancer Excel Worksheet Functions 2 November 2nd 07 03:57 AM
Convert a Number Code to a Text Code Traye Excel Discussion (Misc queries) 3 April 6th 07 09:54 PM


All times are GMT +1. The time now is 05:38 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"