View Single Post
  #9   Report Post  
Posted to microsoft.public.excel,microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default selected numbers to disappear

Max,

Something like this I hope...
'------------------------------

'July 06, 2004 - Jim Cone
Sub DisplayRandomNames()
Dim RS As Long
Dim objRangeA As Range
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

' Establish where everything goes or comes from.
Set objRangeA = Worksheets(1).Range("A1:A35")
Set objRangeB = Worksheets(2).Range("B1:B35")
Set objRangeC = Worksheets(2).Range("C1:C35")

' Is there anything to work with?
If WorksheetFunction.CountA(objRangeA) < 35 Then
MsgBox "Source list is incomplete on sheet " & objRangeA.Parent.Name & " ", _
vbExclamation, " Max Forget"
GoTo DontCallMe
End If

Worksheets(2).Select
StartOver:
' If objRangeC range is blank then fill
' with names, clear Columns 1 and 2 and exit.
If WorksheetFunction.CountA(objRangeC) = 0 Then
objRangeC.Value = objRangeA.Value
objRangeC.Columns.AutoFit
objRangeB.ClearContents
objRangeB.ColumnWidth = objRangeC.ColumnWidth
Range("A1").ClearContents
Range("A1").ColumnWidth = objRangeC.ColumnWidth
GoTo DontCallMe
End If

' Keep looking until random name is found in objRangeC.
Do While blnNotThere = False
Randomize
RS = Int(Rnd * 35 + 1)
'Find RS position within objRangeC.
If Not IsError(Application.Match(objRangeC(RS), objRangeC, 0)) Then
blnNotThere = True
Range("A1").Value = objRangeC(RS)
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value = objRangeC(RS)
objRangeC(Application.Match(objRangeC(RS), objRangeC, 0)).Delete shift:=xlUp
End If
Loop

' Are you bored yet?
If WorksheetFunction.CountA(objRangeC) = 0 Then
If MsgBox("That's it, folks! .. Repeat? ", vbQuestion + vbYesNo, _
" Max Made Me Do It") = vbYes Then GoTo StartOver
End If

DontCallMe:
Set objRangeA = Nothing
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub
'----------------------------

Regards,
Jim Cone
San Francisco, CA

"Max" wrote in message ...
Nice code, Jim ! A request ..
If instead of 35 numbers,
I have an input list of 35 names
(in say A1:A35 in sheet: Names)
how could your code be modified
to work in the same manner (in a new Sheet2, say)
as it currently does for the numbers ?
And .. the code will "terminate" with
a message, say: "That's it, folks! .. Repeat?"
when all the 35 names have been exhausted
(after the 35th run)
Thanks
Rgds
Max
xl 97
Please respond in thread
xdemechanik <atyahoo<dotcom