View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default Duplicates in Rand Formula


The following is not a formula but VBA code.
I hope that can help you out.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware


'Finds and lists random items from the selection.
'The first two characters in each item must be unique.
'The list is added to the immediate right of the selection.
'Requesting more random items then are available causes the
'code to run without stopping - press the escape key.

Sub WinSomeLoseSome()
'Jim Cone - San Francisco, USA - April 2007
On Error GoTo ErrorSomplace
Dim i As Long
Dim j As Long
Dim N As Long
Dim lngSize As Long
Dim M As Variant
Dim vRng As Variant
Dim arrCheck() As String
Dim arrList() As String
Dim strChars As String

Set vRng = Selection
If vRng.Columns.Count 1 Then
MsgBox "Select only one column", , "First Two Only"
Exit Sub
ElseIf Application.CountA(vRng.Offset(0, 1).Cells) 0 Then
If MsgBox("The random list will overwrite column " & _
vRng.Offset(0, 1).Column & ". " & vbCr & _
"Continue?", vbYesNo, "First Two Only") = vbNo Then
Exit Sub
Else
vRng.Offset(0, 1).ClearContents
End If
End If
lngSize = vRng.Count
M = Application.InputBox("How many random items?", _
"First Two Only", 5, , , , , 1)
If M = False Then
Exit Sub
ElseIf M lngSize \ 3 Then
'Number of random items limited to 1/3 of total items.
'Adjust as necessary...
MsgBox "Too many random items requested. ", , "First Two Only"
Exit Sub
End If

Application.ScreenUpdating = False
ReDim arrCheck(1 To lngSize)
ReDim arrList(1 To M)
j = 1

Randomize
Do While j < (M + 1)
'Get a random number
N = Int(Rnd * lngSize + 1)
'Get first two characters of the random pick.
strChars = Left$(vRng(N), 2)
'If already picked loop will exit early.
For i = 1 To lngSize
If arrCheck(i) = strChars Then Exit For
Next 'i
'If not a duplicate...
If i lngSize Then
'Loop did not find a duplicate.
arrList(j) = vRng(N)
arrCheck(N) = strChars
j = j + 1
End If
Loop
'Change from horizontal array to vertical array and
'add random items to the adjacent column.
Range(Cells(vRng.Row, vRng.Offset(0, 1).Column), _
Cells(M + vRng.Row - 1, vRng.Offset(0, 1).Column)).Value = _
Application.Transpose(arrList())
Application.ScreenUpdating = True
Exit Sub

ErrorSomplace:
Beep
End Sub
'-----------



wrote in message
Hi,
Can anyone help me out. I am generating a random list from a larger
list range. My problem is that I it cannot duplicate the first two
characters in the list. For example: a portion of my list looks like:
55-GWP44934A
55-GWP45138A
WD-CLP35803N
WD-CLP97487G
WD-CLP97700G
WD-GWP19171D
WD-GWP27830C
WE-GWP27974C
WE-GWP28039C
WI-GWP45072A
WI-GWP45080A
WI-GWP45081A
WI-GWP45166A
WI-GWP45173A
WJ-CLP93221H
WJ-CLP97539G
WJ-CLP97541G
My formula that is generating a random selection is:
=INDEX(MRO!$C$2:$C$49400,INT((RAND()*UW!$C$56)+1))
I am getting a return value but what I need is for it not to give me
more than one based on the first two characters of the list. Does that
make sense. For example: I cannot have it return me two values that
both begin with WI. Can anyone help me out?