View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.newusers,microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Random Function in VB

Jim,

1) Tell me if I'm getting warm. You want to count the number of occurences
of a date in column D, and put random numbers next to those dates in column
E.

Now, you don't say where the master StartDate is stored, the date that all
the other dates are compared to.

For the example code, let's say that the master start date is stored in cell
A1.

Instead of your procedure Check_Start_Date, the single line

GroupCount = Application.CountIf(Range("D:D"), Range("A1"))

will count occurences of that date in column D of the activesheet.

That said, try running the first macro below (but copy both the sub and the
function into the same codemodule - the sub uses the function to create the
random numbers). When run, the sub will put random numbers next to the dates
in column D that match the date value in cell A1.

If you need help modifying the code beyond that, post again.

HTH,
Bernie
MS Excel MVP

Sub JimsRandomNumbers()
Dim myRand As Variant
Dim myCnt As Integer
Dim i As Integer
Dim myCell As Range

myCnt = Application.CountIf(Range("D:D"), Range("A1"))
myRand = UniqueRands(1, myCnt, myCnt)

With Range("D:D")
Set myCell = .Find(Range("A1").Value)
myCell(1, 2).Value = myRand(LBound(myRand))

For i = 2 To myCnt
Set myCell = .FindNext(myCell)
myCell(1, 2).Value = myRand(i)
Next i
End With
End Sub

Function UniqueRands(ByVal MinNum As Long, _
ByVal MaxNum As Long, _
ByVal NumResults As Long) As Variant

Dim NumArr() As Long
Dim ResArr() As Long
Dim ResNdx As Long
Dim GetNdx As Long
Dim GetCounter As Long
Dim TempCounter As Long
Dim myTemp As Variant
Dim i As Integer
Dim j As Integer

If MinNum = MaxNum Then
UniqueRands = Null
Exit Function
End If
If NumResults Abs(MaxNum - MinNum + 1) Then
UniqueRands = Null
Exit Function
End If

ReDim NumArr(1 To Abs(MaxNum - MinNum + 1))
ReDim ResArr(1 To NumResults)

For ResNdx = 1 To UBound(NumArr)
NumArr(ResNdx) = MinNum + ResNdx - 1
Next ResNdx

For ResNdx = 1 To NumResults
GetCounter = Int((UBound(NumArr) * Rnd) + 1)
GetNdx = 1
TempCounter = 0
Do Until TempCounter = GetCounter
If GetNdx = UBound(NumArr) Then
GetNdx = 1
Else
GetNdx = GetNdx + 1
End If

If NumArr(GetNdx) = MinNum Then
TempCounter = TempCounter + 1
End If
Loop
ResArr(ResNdx) = NumArr(GetNdx)
NumArr(GetNdx) = MinNum - 1
Next ResNdx

UniqueRands = ResArr

End Function

"Jim Campbell" wrote in message
...
Bernie,
1)Date is stored in Lottery .xls in column 4 , want to get number with

same
date and store in GroupCount(see below)
if the date is different, then exit and go to step 2

Sub Check_Start_Date()
Check = True: GroupCount = 0 ' Initialize variables.
Do ' Outer loop.
Do While StartDate = StartDate ' Inner loop.
GroupCount = GroupCount + 1 ' Increment Counter.
If StartDate < StartDate Then 'If condition is True.
Check = False ' Set value of flag to False.
Exit Do ' Exit inner loop.
End If
Loop
Loop Until Check = False ' Exit outer loop immediately
End Sub

2) Yes, the value from GroupCount will be used to generate the Random

number
, and within the value put out the random number to column 5 in the
Lottery.xls spreadsheet i.e.: GroupCount is 8, put out value from 1-8 in
column 5 all within the same date range(GroupCount with the same date)

3) I don't know if it is more efficient to output random number within

step
2 and a new value will be put out every time within the date range

criteria,
the new column will have the Random number generated from the function

Hope I made this clear, your input is appreciated