Generating a Random Number Table, where all of the numbers within the table are not used

[robreich]

I received some help on this Forum last October from Rick Rothstein creating a Random Number generator table, assuming 500 numbers (1 - 500). This Table is being used for a Reverse Raffle at a Charity Function in Ohio. To execute the macro, I am prompted to enter the first number in the Table, the last number in the Table, and how many numbers I want in each row of the Random Number Table. A question has come up as we approach our first use of the macro this coming October. What if all of the 500 tickets are not sold? They are being sold by multiple people that are members of the organization that is sponsoring the Charity Function. Everyone is given 10 tickets to sell. In a lot of cases, they sell only a portion of them and turn the unsold ones back into the Chairman. He then tries to use them as he gets more requests for tickets, but by the Evening of the fund raiser, there are always a number of tickets that have not been sold. Obviously, if the last ticket sold is less than 500, we simply enter that as the LAST NUMBER. However, is there a way to deal with the issue if tickets within the Table have not been sold, i.e. Tickets Number 275 thru 280 do not sell, 340 thru 345 do not sell, etc.? Right now, we are assuming that their are no unsold tickets in the Table of Numbers. One of the reasons of trying to address this is that every 10th ticket drawn wins a $25.00 Gift Card. If we simply put the unsold tickets up on the board and remove them as they are "drawn", then the "unsold tickets" mess up the Gift Cards.


I was thinking along the lines of building a Table Range that contains all of the SOLD Tickets only (leaving a blank cell where a ticket has not sold). Then, having the macro pull the random numbers from this Table Range. Not sure if that makes sense or it is doable, but if someone could help me with this, it would be greatly appreciated.

I am working in EXCEL 365 and my Operation System is Windows 10.

If someone needs additional information or has questions, please post them here. I will be checking the forum daily.

Thank you in advance for any help you can give me.

Bob Reichert

 

[robreich]

Rick,

Now, when the macro creates Column B numbers, there are blank spaces in that Column. Column A only has the blanks in the numbers that I deleted, but now it is Column B. I still get the correct number of Random Numbers generated though. I ran it with 3 different sets of numbers to see if the lines with the blanks were the same all the time (250, 300, and 510) but they appear to be random as the blank spaces are on different lines each time.

Also, now at the end, Column A is left, but Column B is erased.

 

[Peter_SSs]

... and my modified version?

 

[robreich]

Peter,

I have not had time today to try your modified version. Will try it either later tonight or tomorrow.

Bob

 

[robreich]

Peter,
I opened the EXCEL file that I had your old Code in and deleted that macro and then copied your new V3 into it. I tested it and it worked just the way I was hoping to get to.

To clarify what you consider to be a contradictory statement, I am not a programmer, so I am not sure of the correct terminology. My intent is that when I open the file, somehow I would want the data that may have been created on a previous use of the program to be erased before proceeding with a new run. For example, I just tested your Code/Program/Macro and it worked fine. I then decided to test it again by changing the parameters on Sheet1 without manually DELETING anything on Sheet2. When I tried to run it, I got an error message and it would not run (I am assuming because there were already numbers on the Sheet2). I don't want it to be deleted at the end, because then the entire Table would be lost and if there was any question about the data, it would be gone and we couldn't discuss it. I have had people come up to me and say "Can you tell me when my number was pulled. I had to go to the restroom and had to wait and when I came back, my ticket was off of the board". All I have to do is look back and find his number and tell him it was pulled in the XX draw of 10 numbers.

Ideally, what I would like to have is a BLANK Template to start from. That would mean deleting all of the data on Sheet1 and Sheet2 at the very beginning of the "RUN" and then prompting me to enter the Low number, then the High number, then the Number of #s in a Row, then the Numbers to Exclude, then to enter Yes or No for Start again. After completing this, then the "Macro" would run generating the Table of Random Numbers one row at a time. This may mean two separate macros - the first one erasing everything and prompting the user for all of the parameters on Sheet1 and then a second one that would generate the Random Number table. As I said, I am not a programmer, so I don't know if, when the first macro has been satisfied, it could prompt the user to now run the DrawNumbers Macro.

If this is too complicated, I will just have to remember to delete all data on both sheets before running the program.

Bob

 

[Peter_SSs]

OK, try this then in a workbook with Sheet1 and Sheet2

In the vba window, double-click the ThisWorkbook module of your project and paste this code.

Private Sub Workbook_Open()
  StartOver
End Sub

In a standard module place all of this code.

Private d As Object

Sub DrawNumbers_v4()
  Static r As Long, Low As Long, High As Long, Cols As Long
  
  Dim i As Long, c As Long, Draw As Long
  Dim Resp As VbMsgBoxResult
  Dim bExit As Boolean
  
  If d Is Nothing Then
    Set d = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
      Low = .Range("A2").Value
      High = .Range("B2").Value
      Cols = .Range("C2").Value
      For i = Low To High
        d(i) = 1
      Next i
      For r = 2 To .Range("D" & .Rows.Count).End(xlUp).Row
        For i = Split(.Cells(r, "D").Value, "-")(0) To Split(.Cells(r, "D").Value & "-" & .Cells(r, "D").Value, "-")(1)
          d.Remove i
        Next i
      Next r
    End With
    r = 0
  ElseIf d.Count = 0 Then
    bExit = True
    Resp = MsgBox(Prompt:="No more numbers to draw. Do you want to start again?", Buttons:=vbYesNo)
    If Resp = vbYes Then StartOver
  End If
  If Not bExit Then
    r = r + 1
    If Cols > d.Count Then Cols = d.Count
    With Sheets("Sheet2")
      For i = 1 To Cols
        c = c + 1
        Draw = d.Keys()(Int(Rnd() * d.Count))
        .Cells(r, c).Value = Draw
        d.Remove Draw
      Next i
      .Activate
      ActiveWindow.ScrollRow = r
    End With
  End If
End Sub

Sub StartOver()
  Set d = Nothing
  Application.ScreenUpdating = False
  With Sheets("Sheet2")
    .UsedRange.ClearContents
    Application.Goto Reference:=.Range("A1"), Scroll:=True
  End With
  With Sheets("Sheet1")
    .UsedRange.ClearContents
    .Columns("D").NumberFormat = "@"
    .Range("A1:D1").Value = Array("Low", "High", "#s Per Row", "Exclude")
    Application.Goto Reference:=.Range("A1"), Scroll:=True
    .Range("A2").Select
  End With
  Application.ScreenUpdating = True
  MsgBox "Please enter values below these headings & then run the Draw_Numbers macro when ready."
End Sub

Now save the workbook, close it and then re-open it.

 

[robreich]

Works just the way I want it to.

Thank you for your patience. Tomorrow night is our Charity Event and the first reverse raffle using the computer to randomly draw the numbers. Looking forward to being able to do this. In the past 8 years we have used a rotating drum and physically pulled out 10 numbers at a time, which took too long when dealing with close to 450 tickets. So, I started looking at this option last year after our event and now i have what I want, after getting it into the form that satisfies all of the naysayers that I have to deal with.

Thanks again.

Bob

 

[Peter_SSs]

Works just the way I want it to.

Cheers.

Probably should add one more line in the main DrawNumbers procedure

If d Is Nothing Then
  Randomize
  Set d = CreateObject("Scripting.Dictionary")

 

[robreich]

Peter,

Where should I add these lines?

 

[Peter_SSs]

Peter,

Where should I add these lines?

You only add the blue one and you add it between the two existing ones shown.

 

[robreich]

OK. Done. Tested and it ran fine.

Thanks again.