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

robreich

New Member
Joined
Oct 27, 2017
Messages
31
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
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Set up a blank sheet like this:

Excel 2012
ABCD
1LowHigh#s Per RowExclude
2150010275
3276
4277
5278
6279
7301
8302
9303
10477
11478
12479
13480
14198
15199
16200
17

<tbody>
</tbody>
Sheet3

Now you can use this macro:

Rich (BB code):
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.
 
Upvote 0
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. :))

Code:
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
ABCDEFGHIJKLMNO
1LowHigh#s Per RowExclude457828947494682466474458
21500105965482470594954811149257
319794631090714694984143
425-2847647587498487354524963777
5101-45016499993831718467488
65005162524904946444293097
7686745655963432911474
8485424696350486100957015
9864604844774814886945476
1078725460387364971266
11588523844045945122489462
1288612047380472455479133
1313245631646147145348339
145347892754548049346421491
159373465
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.
 
Last edited:
Upvote 0
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...
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]
Code:
[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]
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
Code:
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.

Code:
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
 
Last edited:
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top