weAscend.com

Function fRand(intStart As Integer, intEnd As Integer, _
intReturn As Integer, fUnmatched As Boolean) As String

'*********************************
'Author: Michael Blake
'Contact Via: www.weAscend.com
'Date: 07/09/2000
'
'Example:
'fRand(3,24,5,True)
'
'3 = The starting number of the range
'24 = The ending number of the range
'5 = The number of integers to return.
'True = There will be no duplicate numbers
'
'Notes: If fUnmatched is True then intReturn is
' limited to the number of integers
' between intStart And intEnd.
' If fUnmatched is False then intReturn is
' unlimited.
'
'Please include this information when using
'this function. - Thank you
'********************************

Dim aintExclude() As Boolean
Dim i As Integer
Dim intCount As Integer
Dim intTemp As Integer
Dim strDelim As String

On Error GoTo Error_Handler

If (intEnd - intStart) < (intReturn - 1) And _
fUnmatched = True Then GoTo Error_Handler

fRand = (Int((intEnd - intStart) * Rnd()) + 1) + (intStart - 1)
ReDim aintExclude(intStart To intEnd)
aintExclude(fRand) = True
If intReturn = 1 Then GoTo Exit_Function

strDelim = ", "
i = 1
intCount = 1

Randomize

If fUnmatched = True Then
   For i = 1 To intReturn - 1
Start_Again:
      intTemp = (Int((intEnd - (intStart - 1)) * Rnd()) + 1) + (intStart - 1)
      If aintExclude(intTemp) Then GoTo Start_Again
      aintExclude(intTemp) = True
      fRand = fRand & strDelim & intTemp
   Next i
Else
   For i = 1 To intReturn - 1
      fRand = fRand & strDelim & intTemp
   Next i
End If

Exit_Function:
   Exit Function

Error_Handler:
   fRand = "#Error#"
   GoTo Exit_Function

End Function

 

Contact Us