CODEWITHSUNDEEP
excelvbarandom
Isabella
Isabella

Reputation: 455

Exclude counter number in selecting random names in Excel VBA

I have working code I got on the internet where a name is randomly picked from Column A with a default counter of "0" (Column B). I added a modification where if the name has been picked, the value of "0" becomes "1". However I am confused as to where I can add the logic where if the value in Column B is already 1, it will not be included in the next random pick since technically, the person with the value of 1 in the counter has already won.

enter image description here

Sample data:

Names       | Counter
Newt        | 0
Thomas      | 0
Teresa      | 1
Katniss     | 0
Peeta       | 0
Gale        | 0
Haymitch    | 0
Hazel Grace | 0
Augustus    | 0

Code when "Draw Winner" is clicked:

Sub draw_winners()
    draw  
End Sub

Function draw()
    Dim x As Integer
    Dim delay_ms As Integer

    Dim prize_y As Integer
    Dim name_matched As Boolean


    Dim randm As Integer
    x = get_max

    'CELL (ROW, COLUMN)

    delay_ms = 20 'how many draws before final

draw_winner:
    randm = rand_num(x)
    Cells(1, 3).Value = Cells(randm, 1).Value
    'winner_window.winner_name.Caption = Cells(1, 3).Value
    name_matched = check_names(Cells(1, 3).Value, 1)
    If delay_ms > 0 Then
        WaitFor (0.1)
        delay_ms = delay_ms - 1
        GoTo draw_winner
    End If
    If name_matched = True Then
        GoTo draw_winner
    End If

    Cells(randm, 2).Value = 1

End Function

Function check_names(name As String, rndm As Integer) As Boolean
    Dim i As Integer
    Dim winner As String
    check_names = False
    i = 2
check_name:
    winner = Cells(i, 4).Value
    If winner <> "" Then
        If winner = name And i <> rndm Then
            check_names = True
        End If
    End If
    i = i + 1
    If i < 1000 Then
        GoTo check_name
    End If

End Function


Function get_max() As Integer
    Dim i As Integer
    i = 2
check_blank_cell:
    If Cells(i, 1).Value <> "" Then 'starts at the second row
        i = i + 1
        If i > 10000 Then
            MsgBox "Max Limit Reached!"
            Else
            GoTo check_blank_cell
        End If
    End If

    get_max = i - 1
End Function

Function rand_num(max As Integer) As Integer
    Dim Low As Double
    Dim High As Double
    Low = 2 '<<< CHANGE AS DESIRED
    High = max '20 '<<< CHANGE AS DESIRED
    r = Int((High - Low + 1) * Rnd() + Low)
    rand_num = r
End Function

Sub WaitFor(NumOfSeconds As Single)
    Dim SngSec As Single
    SngSec = Timer + NumOfSeconds

    Do While Timer < SngSec
        DoEvents
   Loop
End Sub

Apologies if this has been asked. Your help will be deeply appreciated.

Upvotes: 2

Views: 362

Answers (2)

Pᴇʜ
Pᴇʜ

Reputation: 57683

An easy (and fast) way would be to sort data by counter as a first step (so all 0 counters come first) before drawing a new name.

With ActiveSheet.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange Range("A:B")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

and use the amount of zeros x = Application.WorksheetFunction.CountIf(Range("B:B"), 0) as maximum for your random number generator rand_num(x). This way only names with 0 are drawn.

enter image description here Image 1: Only the selected rows are used to draw a name.

Also see How to Sort Data in Excel using VBA (A Step-by-Step Guide).

Upvotes: 2

JvdV
JvdV

Reputation: 75840

The below will return an array of names that have not yet won. A random name gets picked and column B gets adjusted accordingly. Maybe it comes in handy:

Sub Test()

Dim lr As Long
Dim arr As Variant
Dim nom As String
Dim rng As Range

With Sheet1 'Change accordingly

    'Get last used row
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row

    'Get range into memory (array)
    arr = Filter(.Evaluate("TRANSPOSE(If(B2:B" & lr & "=0,A2:A" & lr & ",""|""))"), "|", False)
    If UBound(arr) = -1 Then Exit Sub

    'Get a random name from array
    nom = arr(Int(Rnd() * (UBound(arr) + 1)))

    'Get the range where name resides
    Set rng = .Range("A2:A" & lr).Find(nom, LookIn:=xlValues, lookat:=xlWhole)

    'Change value in B column
    rng.Offset(, 1).Value = 1

    'Do something with randomly picked name
    Debug.Print nom

End With

End Sub

Upvotes: 2

Related Questions