ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   selected numbers to disappear (https://www.excelbanter.com/excel-programming/303232-selected-numbers-disappear.html)

Martyn Wilson

selected numbers to disappear
 
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
----------------------------------------


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.714 / Virus Database: 470 - Release Date: 02.07.2004



Martyn Wilson

selected numbers to disappear
 
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" wrote in message
...
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" wrote in message
...
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
----------------------------------------


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.714 / Virus Database: 470 - Release Date: 02.07.2004






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004



Martyn Wilson

selected numbers to disappear
 
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

"Jim Cone" wrote in message
...
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

"Martyn Wilson" wrote in message

...
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
----------------------------------------




---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004



Bob Phillips[_6_]

selected numbers to disappear
 
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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
----------------------------------------


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.714 / Virus Database: 470 - Release Date: 02.07.2004






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004





Martyn Wilson

selected numbers to disappear
 
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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
----------------------------------------


---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.714 / Virus Database: 470 - Release Date: 02.07.2004






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004



Jim Cone

selected numbers to disappear
 
Martyn,

"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" wrote in message ...
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

- snip -

Martyn Wilson

selected numbers to disappear
 
Thank you so much Jim,
You did it perfectly.
Martyn

"Jim Cone" wrote in message
...
Martyn,

"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" wrote in message

...
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

- snip -



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004



Max

selected numbers to disappear
 
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
----



Jim Cone

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



Max

selected numbers to disappear
 
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 <atyahoo<dotcom
----
"Jim Cone" wrote in message
...
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





Jim Cone

selected numbers to disappear
 
Max,
You are welcome.
Jim Cone

"Max" wrote in message ...
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 <atyahoo<dotcom


- snip -

Martyn Wilson

selected numbers to disappear
 
Thanks from me to Jim...I'am following up the thread...
Martyn

"Jim Cone" wrote in message
...
Max,
You are welcome.
Jim Cone

"Max" wrote in message

...
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 <atyahoo<dotcom


- snip -



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.715 / Virus Database: 471 - Release Date: 04.07.2004




All times are GMT +1. The time now is 09:42 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com