Mouse-click event

[hockey1234]

Hello,
I have a numbers going from 1 to 42 in Range("B5:C25").
I have a Range("E5:E10"), which is empty.

I want to create a procedure that does the following:
When the user clicks on a number (1 to 42), this number automatically appears in chronological order in the other range.
The user can pick up to 6 numbers.

Any help would be greatly appreciated !!

[Kenneth Hobs]

Can you be a bit more detailed?

e.g. Click B5 so E5 would be 1, E6=2, etc.

Or: Click B6 and 2 is put in the first empty cell of E5:E10. Click B5 and 1 is put into the next empty cell after the 2.

[hockey1234]

Well it is the same concept as a bingo let's say..
The player has 42 choices (1 to 42), which are in Range("B5:C25")
He has to pick 6 numbers (one at a time) out of the 42 numbers.
When a number is chosen (with a mouse-click on the number), I want it to appear in the Range("E5:E10") in chronological order (i.e if the player picks 40,30,8,3,20 ; these number should appear as 3,8,20,30,40 in the Range("B5:C25"). The cells of the 6 chosen numbers should also appear in red after being picked.
I hope it clarifies..

[Kenneth Hobs]

Right click Sheet1 and View Code to see how I did it or review this code. I guess this sort of thing might be useful for some lottery picks as well. Of course an alternative method would use conditional formatting to set the colors.

[vba]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iR As Range
Dim r As Range, f As Range, fBlank As Range

Application.EnableEvents = False

Set iR = Intersect(Range("B5:C25"), Target)
If iR Is Nothing Then GoTo EndSub

For Each r In iR
Set fBlank = RangeFound("")
If fBlank Is Nothing Then GoTo EndSub

Set f = RangeFound(r.Value)
If f Is Nothing Then
r.Interior.ColorIndex = 3
fBlank.Value = r.Value
End If

SortPicks

r.Activate

NextR:
Next r

EndSub:
Application.EnableEvents = True
Set iR = Nothing
Set r = Nothing
Set f = Nothing
Set fBlank = Nothing
End Sub

Private Function RangeFound(fString As String) As Range
Dim f As Range
Set f = Range("E4:E10").Find(What:=fString, After:=Range("E4"), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If f Is Nothing Then Set RangeFound = Nothing
Set RangeFound = f
End Function

Private Sub SortPicks()
Application.EnableEvents = False
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("E5:E10") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("E5:E10")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.EnableEvents = True
End Sub

Private Sub btnClearPicks_Click()
Application.EnableEvents = False
Range("E5:E10").Value2 = Empty
Range("B5:C25").Interior.ColorIndex = 0
Application.EnableEvents = True
End Sub
[/vba]

[mikerickson]

Cross posted
http://www.excelforum.com/excel-prog...use-click.html

and

http://www.mrexcel.com/forum/showthread.php?t=508128

Is this the same question as the other thread in this forum?
http://www.vbaexpress.com/forum/showthread.php?t=34936

[hockey1234]

sorry for the cross post, I was just trying to get a fast answer..
Not gonna happen anymore..