selected numbers to disappear

  • Thread starter Thread starter Martyn Wilson
  • Start date Start date
M

Martyn Wilson

Hi,
The below code is for drawing random numbers between 1-35 (not repeating).
The drawn number is being displayed in A1 and at the same time beeing added
on column B1:B35 as the macro is executed repetedly via a control button. So
far so good. But I need to add a new dimension to this code:
I am also displaying the numbers 1...35 on column C1:C35 and as I go along
selecting random numbers via the macro, I want the drawn number on column C
to disappear one after the other as well...How is this achieved?
TIA
----------------------
Sub Rast()
Dim say As Integer
Dim ara As Range
Dim RS As Integer

say = WorksheetFunction.CountA(Range("B1:B35")) + 1
If say = 36 Then Exit Sub

Randomize
again:
RS = Int((Rnd * 35) + 1)
For Each ara In Range("B1:B" & say)
If ara.Value = RS Then
GoTo again
End If
Next ara
Range("A1") = RS
Cells(say, 2) = RS
End Sub
 
Sub Rast()
Dim say As Integer
Dim ara As Range
Dim RS As Integer
Dim oCell As Range

say = WorksheetFunction.CountA(Range("B1:B35")) + 1
If say = 36 Then Exit Sub

Randomize
again:
RS = Int((Rnd * 35) + 1)
For Each ara In Range("B1:B" & say)
If ara.Value = RS Then
GoTo again
End If
Next ara
If RS = 1 Then
Debug.Print RS
End If
Range("A1") = RS
Cells(say, 2) = RS
Set oCell = Columns(3).Find(RS, lookat:=xlWhole)
If Not oCell Is Nothing Then oCell.ClearContents
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Martyn,

Here is another way to cook it...

'----------------------------------------
Sub DisplayRandomNumbers()
Dim objRangeB As Range
Dim objRangeC As Range
Dim RS As Integer
Dim blnNotThere As Boolean

Set objRangeB = Range("B1:B35")
Set objRangeC = Range("C1:C35")

'Fill column c with numbers
If WorksheetFunction.CountA(objRangeC) = 0 Then
For RS = 1 To 35
objRangeC(RS).Value = RS
Next 'RS
objRangeB.ClearContents
End If

Do While blnNotThere = False
Randomize
RS = Int(Rnd * 35 + 1)
If Len(objRangeC(RS)) Then
blnNotThere = True
Range("A1").Value = RS
objRangeC(RS).ClearContents
objRangeB(WorksheetFunction.CountA(objRangeB) + 1).Value = RS
End If
Loop
Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub
'---------------------------------

Regards,
Jim Cone
San Francisco, CA
 
Hi, an follow-up addy...:)
Is it possible to fill in the remaining cells as we move along clearing the
drawn list numbers on column C1:C35 ?
Martyn

Bob Phillips said:
Sub Rast()
Dim say As Integer
Dim ara As Range
Dim RS As Integer
Dim oCell As Range

say = WorksheetFunction.CountA(Range("B1:B35")) + 1
If say = 36 Then Exit Sub

Randomize
again:
RS = Int((Rnd * 35) + 1)
For Each ara In Range("B1:B" & say)
If ara.Value = RS Then
GoTo again
End If
Next ara
If RS = 1 Then
Debug.Print RS
End If
Range("A1") = RS
Cells(say, 2) = RS
Set oCell = Columns(3).Find(RS, lookat:=xlWhole)
If Not oCell Is Nothing Then oCell.ClearContents
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Martyn Wilson said:
Hi,
The below code is for drawing random numbers between 1-35 (not repeating).
The drawn number is being displayed in A1 and at the same time beeing added
on column B1:B35 as the macro is executed repetedly via a control
Click to expand...
button.
So
far so good. But I need to add a new dimension to this code:
I am also displaying the numbers 1...35 on column C1:C35 and as I go along
selecting random numbers via the macro, I want the drawn number on
Click to expand...
column
Click to expand...
 
Hi, a follow-up addy...:)
Is it possible to fill in the remaining cells as we move along clearing the
drawn list numbers on column C1:C35 ?
Martyn
 
Pardon, I do not understand.

Fill what cells, with what?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

Martyn Wilson said:
Hi, an follow-up addy...:)
Is it possible to fill in the remaining cells as we move along clearing the
drawn list numbers on column C1:C35 ?
Martyn
Click to expand...
 
Hope I can express myself:
Say we have numbers 1...35 on column C1:C35. When we select a random number
(say 15) via our macro, the cell containing that number (C15) is cleared.
Now I wonder if we can move the rest of the remaining number list on column
C1:C35 upwards so that the "cleared" cells are pushed towards the bottom of
column C.
TIA



Bob Phillips said:
Pardon, I do not understand.

Fill what cells, with what?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Click to expand...
 
Martyn,

Re: "Now I wonder if we can move the rest of the remaining number list on column
C1:C35 upwards so that the 'cleared' cells are pushed towards the bottom of
column C."

Here is my modified code...
'-------------------------------
Sub DisplayRandomNumbers()
Dim RS As Long
Dim objRangeB As Range
Dim objRangeC As Range
Dim blnNotThere As Boolean

Set objRangeB = Range("B1:B35")
Set objRangeC = Range("C1:C35")

' If objRangeC range is blank then fill
' with numbers, clear Columns 1 and 2 and exit.
If WorksheetFunction.CountA(objRangeC) = 0 Then
For RS = 1 To 35
objRangeC(RS).Value = RS
Next 'RS
objRangeB.ClearContents
Range("A1").ClearContents
Exit Sub
End If

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

Set objRangeB = Nothing
Set objRangeC = Nothing
End Sub
'-----------------------------

Regards,
Jim Cone
San Francisco, CA

Martyn Wilson said:
Hi, a follow-up addy...:)
Is it possible to fill in the remaining cells as we move along clearing the
drawn list numbers on column C1:C35 ?
Martyn
Click to expand...
- snip -
 
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
 
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
 
Superb ! Runs smooth as silk ..

Many thanks, Jim !

Liked the thoughtful comment-lines and ...
especially the "personal touch" dialogs <bg>
 
Max,
You are welcome.
Jim Cone

Max said:
Superb ! Runs smooth as silk ..
Many thanks, Jim !
Liked the thoughtful comment-lines and ...
especially the "personal touch" dialogs <bg>
Rgds
Max
xl 97
Please respond in thread
xdemechanik <at>yahoo<dot>com
Click to expand...

- snip -
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

preventing endless loops 6
can it be adopted for a 16 team 4 group? 1
Modify working code to expand the output. 5
Produce Random Numbers 6
Six columns randon no.'s no dupes 6
Code rounds to whole numbers, need it to stay with decimals 4
Array coding type mismatch 6
passing array reference to sumproduct formula-??? 1

Back
Top