VBA: Random Name Selector with no repeat

[gd6noob]

Hi everyone,

I would like to create a Random Name Selector with no repeat. I would like to make this a little more fancier visually and not sure if it would work.

1. What I had in mind is when I press button, the cell A2 would highlight and then move to the next cell down the range, from faster to slower and then it stop. Then that name will be in D2. Then I would press the button again and does the same and the next name would go into D3. All I need 2 names.
2. Next, in column A, if they were previously selected, then it would indicate yes for in future, it would not include them in the random name selector. e.g. today I ran this and Name 3 and Name 9 were select, A4 and A10 would show yes and tomorrow when I run this again, they would not be included in the next random name selector.

Random Name Selector with No Repeat1.xlsb
	A	B	C	D	E
1	Previously Selected?	Name
2		Name 1		Name 1	Name 1
3		Name 2		Name 2	Name 2
4	Yes	Name 3
5		Name 4
6		Name 5
7		Name 6
8		Name 7
9		Name 8
10	Yes	Name 9
11	Yes	Name 10
12		Name 11
13		Name 12
Sheet1

 

[Marc L]

Hi,​

​

if names are unique in column B so column A is useless …​

 

[gd6noob]

Yes, the names will all be unique but I would not want the names to repeat until I have gone through the entire list of names.
E.G. lets say I have 52 names and on Week 1 Monday, it selected Name 3.
Following Monday, Week 2, instead of having 52 names to select from, only 51 because Name 3 was selected last week. So then it selects Name 9.
Following Monday, Week 3, instead of having 51 names to select from, only 50 because Name 9 was selected last week. So then it selects Name 10.
If there is less then 52 names, lets say 20 names. After going through all 20 names, it would reset and have 20 names to select from at the start.

I hope this makes sense. If Column A is still not needed, then I'm good to remove this. Whatever is easiest.

 

[lrobbo314]

Seems a bit over the top with the cell highlighting step, but it seemed like a fun little exercise. There are definitely more efficient ways of doing this.

But, this seems to do the trick on your sample data.

Public n As Integer

Sub wod()
Dim r As Range:         Set r = Range("B2:B13")
Dim inc As Single:      inc = 0.1
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 * 1500) ^ 2
    Next i
    ro = ro + 1
    inc = inc * (1 + Rnd() / 100)
    DoEvents
Wend

If Range("A" & ro).Value = "Yes" Then
    If Application.WorksheetFunction.CountA(r.Offset(, -1)) < r.Cells.Count Then
        ro = FindNext(r, ro - 1)
        Range("A" & ro).Value = "Yes"
        r.Cells.Interior.ColorIndex = -4142
        r.Cells(ro - 1).Interior.ColorIndex = 6
    Else
        r.Offset(, -1).ClearContents
        Range("E2:E3").ClearContents
        n = 0
    End If
Else
    Range("A" & ro).Value = "Yes"
End If

Select Case n
    Case 0
        Range("E2").Value = r.Cells(ro - 1).Value
    Case 1
        Range("E3").Value = r.Cells(ro - 1).Value
    Case 2
        Range("E2:E3").ClearContents
        Range("E2").Value = r.Cells(ro - 1).Value
        n = 0
End Select

n = n + 1
End Sub

Function FindNext(r As Range, ro As Integer)

For i = 1 To r.Rows.Count
    ro = ro + 1
    If ro > r.Rows.Count Then ro = 1
    If r.Cells(ro).Offset(, -1).Value = "" Then
        FindNext = ro + 1
        Exit Function
    End If
Next i
End Function

 

[Marc L]

If Column A is still not needed, then I'm good to remove this. Whatever is easiest.

Column A could be useless if previous names are in column E but if each time column E is cleared then column A is necessary …​

​

 

[gd6noob]

Seems a bit over the top with the cell highlighting step, but it seemed like a fun little exercise. There are definitely more efficient ways of doing this.

But, this seems to do the trick on your sample data.

Public n As Integer

Sub wod()
Dim r As Range:         Set r = Range("B2:B13")
Dim inc As Single:      inc = 0.1
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 * 1500) ^ 2
    Next i
    ro = ro + 1
    inc = inc * (1 + Rnd() / 100)
    DoEvents
Wend

If Range("A" & ro).Value = "Yes" Then
    If Application.WorksheetFunction.CountA(r.Offset(, -1)) < r.Cells.Count Then
        ro = FindNext(r, ro - 1)
        Range("A" & ro).Value = "Yes"
        r.Cells.Interior.ColorIndex = -4142
        r.Cells(ro - 1).Interior.ColorIndex = 6
    Else
        r.Offset(, -1).ClearContents
        Range("E2:E3").ClearContents
        n = 0
    End If
Else
    Range("A" & ro).Value = "Yes"
End If

Select Case n
    Case 0
        Range("E2").Value = r.Cells(ro - 1).Value
    Case 1
        Range("E3").Value = r.Cells(ro - 1).Value
    Case 2
        Range("E2:E3").ClearContents
        Range("E2").Value = r.Cells(ro - 1).Value
        n = 0
End Select

n = n + 1
End Sub

Function FindNext(r As Range, ro As Integer)

For i = 1 To r.Rows.Count
    ro = ro + 1
    If ro > r.Rows.Count Then ro = 1
    If r.Cells(ro).Offset(, -1).Value = "" Then
        FindNext = ro + 1
        Exit Function
    End If
Next i
End Function

Thank you, this is great.
And yes, the highlighting cells is mostly for visual effects to make it seem more exciting for everyone watching.

 

[lrobbo314]

Happy to help. Glad it worked out for you!