VBA highlight random selection more mathematical.

[motilulla]

Using Excel 2010

Hello,

I got a list of 21 salesmen in the column E in the cells E6:E26 I need a VBA which can at the end of selection should highlight selected one random salesman name at a time and give a message for example “salesman 09 is chosen”

Resume:
1- Once macro button is pressed start highlighting the first name of cell “E6” and then move to downside through the end of the list. (repeat the process from top to bottom again and again till the random selection is done within 4 to 5 rounds, like a roulette wheel)
2- After the random selection of the salesman is finish selection could be highlight.
3- After highlighted eventually give a message of highlighted salesman for example “salesman 09 is chosen”
4- When the macro button is pressed again, the 'roulette' highlighting process starts again, and eventually another selected name would be highlighted with their message.
5- I really needed is a slowdown code which won't just be linear random selection it must be more mathematical while choosing the names.
6- Is this possible?

Excel Question.xlsx
	A	B	C	D	E	F	G	H	I
1
2
3					Random
4					Selection
5
6					Salesman 01
7					Salesman 02
8					Salesman 03
9					Salesman 04
10					Salesman 05
11					Salesman 06
12					Salesman 07
13					Salesman 08
14					Salesman 09
15					Salesman 10
16					Salesman 11
17					Salesman 12
18					Salesman 13
19					Salesman 14
20					Salesman 15
21					Salesman 16
22					Salesman 17
23					Salesman 18
24					Salesman 19
25					Salesman 20
26					Salesman 21
27
28
29
30
Sheet2

Thank you all.

Regards,
Moti

 

[footoo]

What is the purpose of highlighting plus a message for one salesman at a time?
Why not use Excel’s Rand function as follows :
• In F6:F27 enter =RAND()
• Sort E6:F27 by column F
The salesmen in column E have now been sorted in a random sequence.

 

[motilulla]

What is the purpose of highlighting plus a message for one salesman at a time?
Why not use Excel’s Rand function as follows :
• In F6:F27 enter =RAND()
• Sort E6:F27 by column F
The salesmen in column E have now been sorted in a random sequence.

Hello footoo, thank you for your response, I appreciate it. Really I want some code which looks visually eye pleasing while random selection it should start and drop down from E6 to down E26 and slow down the speed and selection could be done with in 3 or four rounds. To have some fun not just the random, it can be used for any game as well some time to have fun may be.

Searching in the forum I found very similar code which I think fit for my need. I tried it is designed to work with column A starting from A1 and does not work properly often it stop and keep working without yellow highlight moving from up to down.

Here below is the code link may could be developed for better performance and work within the area I need.
roulette simulator

Kind Regards,
Moti

 

[motilulla]

BMPU

 

[JGordon11]

try the following, adjust the constants to your preference:

Sub SalesmanRoulette()
    Const lag = 2, MinDiv = 5, SpinMin = 100, NumSalesmen = 21, StartRow = 6, Col = 5, Highlight = 65535
    Dim n As Long, i As Long, t As Double
    n = SpinMin + Int(NumSalesmen * Rnd())
    For i = 1 To n
        With Cells(i Mod NumSalesmen + StartRow, Col).Interior
            .Color = Highlight
            t = Timer
            Do While Timer - t < lag / (n + MinDiv - i)
            Loop
            .Pattern = xlNone
        End With
    Next
    With Cells(i Mod NumSalesmen + StartRow, Col)
        .Interior.Color = Highlight
        MsgBox .Value & " selected!"
    End With
End Sub

 

[motilulla]

try the following, adjust the constants to your preference:

Sub SalesmanRoulette()
    Const lag = 2, MinDiv = 5, SpinMin = 100, NumSalesmen = 21, StartRow = 6, Col = 5, Highlight = 65535
    Dim n As Long, i As Long, t As Double
    n = SpinMin + Int(NumSalesmen * Rnd())
    For i = 1 To n
        With Cells(i Mod NumSalesmen + StartRow, Col).Interior
            .Color = Highlight
            t = Timer
            Do While Timer - t < lag / (n + MinDiv - i)
            Loop
            .Pattern = xlNone
        End With
    Next
    With Cells(i Mod NumSalesmen + StartRow, Col)
        .Interior.Color = Highlight
        MsgBox .Value & " selected!"
    End With
End Sub

Hello JGordon11, thank you for the code this is exactly what I was looking for. Also it is perfect adapted as per my range.

I added following 2 lines code to list the selected salesman in the column H what I noticed
1-code select the salesman in the centre area and
2-Code fire some times and display 2-3 salesmen name in one run.

LastRow = Worksheets("Sheet2").Range("H65536").End(xlUp).Offset(1, 0).Row
Worksheets("Sheet2").Range("H" & LastRow).Value = .Value

Kind Regards,
Moti

 

[motilulla]

try the following, adjust the constants to your preference:

Sub SalesmanRoulette()
    Const lag = 2, MinDiv = 5, SpinMin = 100, NumSalesmen = 21, StartRow = 6, Col = 5, Highlight = 65535
    Dim n As Long, i As Long, t As Double
    n = SpinMin + Int(NumSalesmen * Rnd())
    For i = 1 To n
        With Cells(i Mod NumSalesmen + StartRow, Col).Interior
            .Color = Highlight
            t = Timer
            Do While Timer - t < lag / (n + MinDiv - i)
            Loop
            .Pattern = xlNone
        End With
    Next
    With Cells(i Mod NumSalesmen + StartRow, Col)
        .Interior.Color = Highlight
        MsgBox .Value & " selected!"
    End With
End Sub

Hello JGordon11, searching MrExcel forums I did find other solutions and modified them as per my range which I am placing below, but I will go with your code which is working fine and give this query SOLVED!

'https://www.mrexcel.com/board/threads/vba-random-name-selector-with-no-repeat.1198014/#post-5845954
'VBA: Random Name Selector with no repeat

Sub SalesmanRoulette_Y()
Dim R As Range:         Set R = Range("E6:E26")
Dim inc As Single:      inc = 0.2
Dim ro As Integer:      ro = 1

While inc < 1
    Randomize
    If ro > R.Cells.Count Then ro = 1
    R.Cells.Interior.ColorIndex = -4142
    R.Cells(ro).Interior.ColorIndex = 6
    For i = 0 To (inc * 2500) ^ 2
    Next i
    ro = ro + 1
    inc = inc * (1 + Rnd() / 200)
    DoEvents
Wend

Select Case n
    Case 0
  
    MsgBox R.Cells(ro - 1).Value & " selected!"
        
        n = 0

End Select


End Sub

'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------'

'https://www.mrexcel.com/board/threads/how-to-highlight-a-random-number-from-a-table.72209/#post-347087
'How to highlight a random number from a table?

Sub SalesmanRoulette_Z()
Dim R As Range

Set R = Range("E6:E26")
With R
    
End With

    Range("E6:E42").Select
    With Selection.Interior
        .Pattern = xlNone
    End With
    Range("E6").Select

Randomize
MOVE_OVER = Int(R.Columns.Count * Rnd)
MOVE_DOWN = Int(R.Rows.Count * Rnd)
If MOVE_DOWN = R.Rows.Count Then
    MOVE_OVER = 0
End If
Range("E6").Offset(MOVE_DOWN, MOVE_OVER).Select

With Selection
    .Interior.ColorIndex = 6
  
End With
    
    MsgBox Selection & " selected!"

End Sub

Thank you for your help

Kind Regards,
Moti