lundi 16 décembre 2019

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.




Aucun commentaire:

Enregistrer un commentaire