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

 

[Eric W]

Set up a blank sheet like this:

Excel 2012

	A	B	C	D
Low	High	#s Per Row	Exclude

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]500[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"]275[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]276[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]277[/TD]

[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]278[/TD]

[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]279[/TD]

[TD="align: center"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]301[/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]302[/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]303[/TD]

[TD="align: center"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]477[/TD]

[TD="align: center"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]478[/TD]

[TD="align: center"]12[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]479[/TD]

[TD="align: center"]13[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]480[/TD]

[TD="align: center"]14[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]198[/TD]

[TD="align: center"]15[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]199[/TD]

[TD="align: center"]16[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]200[/TD]

[TD="align: center"]17[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>

Sheet3​

Now you can use this macro:

Sub RandomDraw()
Dim L As Long, H As Long, N As Long
Dim Ex As Variant, Rands() As Long, Output()
Dim i As Long, lr As Long, ctr As Long, x As Long
    
    L = Cells(2, "A")
    H = Cells(2, "B")
    N = Cells(2, "C")
    
    lr = Cells(Rows.Count, "D").End(xlUp).Row
    If lr > 1 Then
        Ex = WorksheetFunction.Transpose(Range("D2:D" & lr + 1).Value)
    End If
    
    ReDim Rands(1 To H)
    ctr = 0
    On Error Resume Next
    For i = L To H
        x = -1
        If lr > 1 Then x = WorksheetFunction.Match(i, Ex, 0)
        If x = -1 Then
            ctr = ctr + 1
            Rands(ctr) = i
        End If
    Next i
    
    On Error GoTo 0
    ReDim Output(0 To ctr \ N, 0 To N - 1)
    
    For i = 0 To ctr - 1
        x = Int(Rnd() * ctr) + 1
        Output(i \ N, i Mod 10) = Rands(x)
        Rands(x) = Rands(ctr)
        ctr = ctr - 1
    Next i
    
    Cells(1, "F").Resize(UBound(Output) + 1, UBound(Output, 2) + 1) = Output
    
End Sub

which will put the requested random numbers in a table starting in F1. At that point, you can delete columns A:E, or copy them to another sheet, or even have the macro do it for you.

Let us know if this works for you.

 

[Peter_SSs]

With a similar set-up to Eric, here is another variation. A slight difference is that this allows you to exclude ranges in column D, rather than listing every unsold ticket number individually. (I know my sample exclusions below are not realistic but I wanted to keep the result area small so I could show it easily. )

Sub DrawNumbers()
  Dim d As Object
  Dim i As Long, r As Long, c As Long, Low As Long, High As Long, Cols As Long, Draw As Long
  Dim results As Variant
  
  Set d = CreateObject("Scripting.Dictionary")
  Low = Range("A2").Value
  High = Range("B2").Value
  Cols = Range("C2").Value
  ReDim results(1 To High / Cols + 1, 1 To Cols)
  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
  r = 1
  Randomize
  For i = 1 To d.Count
    c = c + 1
    If c > Cols Then
      c = 1: r = r + 1
    End If
    Draw = d.Keys()(Int(Rnd() * d.Count))
    results(r, c) = Draw
    d.Remove Draw
  Next i
  Range("F1").Resize(UBound(results, 1), UBound(results, 2)).Value = results
End Sub

My sample data & results:

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Low	High	#s Per Row	Exclude		457	82	89	47	49	468	2	466	474	458
2	1	500	10	5		9	65	482	470	59	495	481	11	492	57
3				19		79	463	10	90	71	46	94	98	41	43
4				25-28		476	475	87	498	487	35	452	496	37	77
5				101-450		16	499	99	3	83	17	18	467	48	8
6				500		51	62	52	490	494	64	44	29	30	97
7						68	67	456	55	96	34	32	91	14	74
8						485	42	469	63	50	486	100	95	70	15
9						86	460	484	477	4	81	488	69	454	76
10						78	72	54	60	38	7	36	497	12	66
11						58	85	23	84	40	459	451	22	489	462
12						88	61	20	473	80	472	455	479	1	33
13						13	24	56	31	6	461	471	453	483	39
14						53	478	92	75	45	480	493	464	21	491
15						93	73	465
16
Random numbers

Edit: One further point. If you end up using Eric's code, I suggest that you include a Randomize statement or it is possible that you could get repeated identical, or very similar, results.

 

[Rick Rothstein]

I have modified my original code back from October 2017 to hopefully meet what you now need. You will now have two macro... the first (named "ListTicketNumbers") will list out to Sheet2 (which should have nothing on it as the sheet will be cleared) your number list. After you sales are complete and the unused tickets are return... go to Sheet2 and delete the number that were not sold (select the cell or range of cells and press the Delete key). Once these deletions have been done, run the second macro (named "RandomDrawTableMaker") and it will output the randomized list of sold ticket numbers into your grid. The three questions I asked in my original code are now split up between the two macros. Here are the macro's code...

[table="width: 500"]
[tr]
	[td]Sub ListTicketNumbers()
  Dim L As Long, H As Long
  
  ' Get upper and lower limits for the ticket numbers
  On Error GoTo NoNumberEntered
  L = InputBox("Enter the low ticket number:")
  H = InputBox("Enter the high ticket number:")
  On Error GoTo 0
  
  ' Print the ticket numbers out to Sheet2, Column A starting on Row 1
  Sheets("Sheet2").Cells.Clear
  Sheets("Sheet2").Range("A1").Resize(H - L + 1) = Evaluate("ROW(" & L & ":" & H & ")")
  
NoNumberEntered:
End Sub[/td]
[/tr]
[/table]

[table="width: 500"]
[tr]
	[td]Sub RandomDrawTableMaker()
  Dim T As Long, R As Long, LastRow As Long, Cnt As Long, OldUB As Long
  Dim RandomIndex As Long, Tmp As Long, Nums As Variant
  
  ' Make sure the number will always be random each time macro is run
  Randomize
  
  ' Get information to build grid
  On Error GoTo NoNumberEntered
  T = InputBox("Enter the number of tickets per row:")
  On Error GoTo 0
  
  ' Read the sold ticket numbers into a one-dimension array
  With Sheets("Sheet2")
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A1:A" & LastRow).Copy .Range("B1")
    On Error Resume Next
    .Columns("B").SpecialCells(xlBlanks).Delete xlShiftUp
    On Error GoTo 0
    LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
    Nums = Application.Transpose(.Range("B1:B" & LastRow))
  End With
  
  ' Randomize the ordered one-dimensional array of all the numbers
  For Cnt = UBound(Nums) To 1 Step -1
    RandomIndex = Int(Cnt * Rnd + 1)
    Tmp = Nums(RandomIndex)
    Nums(RandomIndex) = Nums(Cnt)
    Nums(Cnt) = Tmp
  Next
  
  ' Distribute the random array of numbers into the grid
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    .Cells.ClearContents
    OldUB = UBound(Nums)
    ReDim Preserve Nums(1 To T + UBound(Nums))
    For R = 1 To OldUB Step T
      .Cells((T + R - 1) / T, "A").Resize(, T) = Application.Index(Nums, 1, Evaluate("TRANSPOSE(ROW(" & R & ":" & R + 20 & "))"))
    Next
  End With
  Application.ScreenUpdating = True
  
NoNumberEntered:
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

I have modified my original code back from October 2017 to hopefully meet what you now need. You will now have two macro... the first (named "ListTicketNumbers") will list out to Sheet2 (which should have nothing on it as the sheet will be cleared) your number list. After you sales are complete and the unused tickets are return... go to Sheet2 and delete the number that were not sold (select the cell or range of cells and press the Delete key). Once these deletions have been done, run the second macro (named "RandomDrawTableMaker") and it will output the randomized list of sold ticket numbers into your grid in Sheet1 (which also must not contain any other data). The three questions I asked in my original code are now split up between the two macros.

I accidentally omitted what I added in red above from what I posted in Message #4 above.

 

[robreich]

Thanks, Guys. All of your solutions worked for me. I decided to go with Rick's, as it kept the first sheet clean except for the Table of Random Numbers. This allows me to hide all of the rows and then display 1 row at a time, only showing the Random Numbers generated (simulating what we do now where we put all tickets in a drum and pull ten at a time. After we remove them all from the board, then we draw 10 more, repeating this process until we have removed all of the tickets and the last four drawn are the big money winners). He also deletes everything that may already be in the columns used before running the rest of the macro(s) so I am always starting with a "clean slate". This insures that I don't have old numbers/data in the ranges when I am working with the macros.

Thanks again. I really appreciate your help.

Bob

 

[Peter_SSs]

.. as it kept the first sheet clean except for the Table of Random Numbers.

Of course the other codes could easily do that too, but if you're happy, I'm happy.

 

[robreich]

Rick,

I hate to keep asking for your help, however, someone has asked me if there would be a way to generate the Random Numbers 1 row at a time, instead of generating the entire Table of numbers. For example, if we had a First Number of 1 and a Last Number of 250 and then eliminated 20 numbers as unsold tickets, we would end up with a column on Sheet2, Column B, of 230 numbers. If we want 10 numbers in a Row, we would execute a macro that would select 10 numbers from Column B, then automatically reduce the number of remaining numbers to 220 by removing the numbers just "drawn", execute the macro again and generate 10 numbers from the 220 remaining and removing the 10 drawn numbers from the column again, thus leaving 210 remaining numbers, etc, etc until all of the original 230 numbers have been displayed. We would want to add each row of 10 to Sheet1 starting on row 1, then going to row 2, then row 3 etc until we had 23 rows in this example. Thus, if we accidentally pulled a wrong number, we would be able to review all of the numbers already "pulled" and check each one until we found the error. From looking at your code, it may mean creating a new column of numbers on Sheet2 in Columns C, D, E, etc as the number of remaining numbers gets reduced by 10 (or whatever the number per row is asked for).

Any information you can give me or help me with would be greatly appreciated.

Bob Reichert

 

[Peter_SSs]

Suggestion: Generate all the numbers at once per existing code (or my modified version here) but hide all the rows except the first one. Each time you want a new row, just double-click anywhere in the visible data.
To set this up, here is my code to generate the numbers, transfer to Sheet2 & hide all but 1 row

Sub DrawNumbers()
  Dim d As Object
  Dim i As Long, r As Long, c As Long, Low As Long, High As Long, Cols As Long, Draw As Long
  Dim results As Variant
  
  Set d = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet1")
    Low = .Range("A2").Value
    High = .Range("B2").Value
    Cols = .Range("C2").Value
    ReDim results(1 To High / Cols + 1, 1 To Cols)
    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 = 1
  Randomize
  For i = 1 To d.Count
    c = c + 1
    If c > Cols Then
      c = 1: r = r + 1
    End If
    Draw = d.Keys()(Int(Rnd() * d.Count))
    results(r, c) = Draw
    d.Remove Draw
  Next i
  With Sheets("Sheet2")
    .Cells.EntireRow.Hidden = False
    .UsedRange.ClearContents
    .Range("A1").Resize(UBound(results, 1), UBound(results, 2)).Value = results
    .UsedRange.Offset(1).EntireRow.Hidden = True
  End With
End Sub

Now ..
1. Right click the Sheet2 name tab and choose "View Code".
2. Copy and Paste the code below into the main right hand pane that opens at step 1.
3. Close the Visual Basic window & test. That is, run the code above, then on Sheet2, double-click one of the numbers in row 1. Then double-click any number in row 1 or row 2 etc.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then
    Cancel = True
    Range("A" & Rows.Count).End(xlUp).Offset(1).EntireRow.Hidden = False
  End If
End Sub

 

[robreich]

Peter,

I already do what you have suggested, i.e. generate the entire Table, then hide all of the rows and un-hide one at a time. The person who asked me if I could "draw" 10 numbers at a time was thinking along the lines of simulating how we use to do it manually where all of the ticket numbers were in a rotating drum and we pulled out 10 at a time. At any point in the draw, all remaining tickets were in the drum being mixed up and each draw was random. From his point of view, there currently is only one random draw and that is the first one to generate the Table. After the first draw, all subsequent draws have already been determined - all we are doing is uncovering them. He would rather see a random draw of all remaining tickets each time we pull out 10 numbers. I hope that makes sense. And maybe this would be difficult to do, but I told him I would pursue it.

Bob