Pick Random From List, Then Delete

[redhots4]

Hi. I have a list of 365 writing prompts, one for each day of the year. I want to randomly select a number (1-365), then look up the prompt for that number. Once that prompt is picked, I want to delete its corresponding number from the list of available numbers so it doesn't get picked again. Anyone done this or have a good solution?

 

[Micron]

There must be a half-dozen ways to get a random value from a list. Did you look at any of them? Here's one method:

VBA Random selection from list of names

Hi All, I'm working on a spreadsheet that I would like to pick a random name from a list of 10 names using a vba button. the list of names are in cells C3:C12 and I would like the selected name to appear in cell D3 Thanks in advance.

www.mrexcel.com

Not sure what "I want" means here. It might mean that you will manually look up and then delete from the list.

 

[redhots4]

There must be a half-dozen ways to get a random value from a list. Did you look at any of them? Here's one method:

VBA Random selection from list of names

Hi All, I'm working on a spreadsheet that I would like to pick a random name from a list of 10 names using a vba button. the list of names are in cells C3:C12 and I would like the selected name to appear in cell D3 Thanks in advance.

www.mrexcel.com

Not sure what "I want" means here. It might mean that you will manually look up and then delete from the list.

Thanks for the reply. I'm well versed in picking random numbers between lower and upper limits. What I need here is (a.) the ability to click a button to pick a number randomly from a list of previously-unused numbers and (b) the ability to instruct Excel to delete a picked number from the list of remaining numbers so it isn't picked again. Deleting the used numbers gives me the ability to visually see the list of prompts dwindling over time.

 

[Peter_SSs]

To understand better and for testing, could we reduce the initial number to 10 instead of 365, post that sample data with XL2BB so that we can see the layout and copy for testing? You might further explain in words, just what would happen on the sheet after each pick.

 

[Micron]

I'm well versed in picking random numbers between lower and upper limits

If by that you mean between x and y numbers, that's not what I intended to suggest by the link. It was supposed to suggest how to choose a value from a list of values. In effect, they're not really "unused" when values are being removed. They either exist in the list, or not. Once randomly chosen and the prompt has been looked up, the code deletes the list value, I guess. I can't see how generating a random number between 1 and 365 and looking that up in a list will ever work if anyone suggests that, because you'll eventually generate values that don't exist in the list. Hence, picking a random list value is part of the solution I'd say.

 

[redhots4]

To understand better and for testing, could we reduce the initial number to 10 instead of 365, post that sample data with XL2BB so that we can see the layout and copy for testing? You might further explain in words, just what would happen on the sheet after each pick.

Good idea. Here's a sample sheet with only ten rows. The formula in C2 returns a value at random from column A. How do I tell Excel that the value chosen at random should not be available for selection again? Ideally, I'd like to copy the value in C2 and append it to a list on another tab with the date, so I could see a list of which prompts I randomly selected by date. (Ignore the conditional formatting error).

365 Gratitude Prompts.xlsm
	A	B	C
1	List		Random
2	Writing Prompt 1		Writing Prompt 12
3	Writing Prompt 2
4	Writing Prompt 3
5	Writing Prompt 4
6	Writing Prompt 5
7	Writing Prompt 6
8	Writing Prompt 7
9	Writing Prompt 8
10	Writing Prompt 9
11	Writing Prompt 10
12	Writing Prompt 11
13	Writing Prompt 12
14	Writing Prompt 13
15	Writing Prompt 14
16	Writing Prompt 15
17	Writing Prompt 16
18	Writing Prompt 17
19	Writing Prompt 18
20	Writing Prompt 19
21	Writing Prompt 20
22	Writing Prompt 21
23	Writing Prompt 22
24	Writing Prompt 23
25	Writing Prompt 24
Sheet1

Cell Formulas
Range	Formula
C2	C2	=INDEX(A2:A25,RANDBETWEEN(2,COUNTA(A2:A25)))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A2:A25	Expression	=#REF!=242	text	NO

 

[Peter_SSs]

Here's a sample sheet with only ten rows.

Hmm, an interesting count of 10!
.. but thanks for getting XL2BB going.

EDIT:
On re-reading, I think that you have answered the following so I will post back in a while.

What about this part

You might further explain in words, just what would happen on the sheet after each pick.

.. or else another XL2BB to show what the sheet would look like after "Writing Prompt 12" has been used?

 

[Peter_SSs]

With Sheet1 as you have shown above. Name a blank sheet in the workbook as 'Log' and try running this code repeatedly.
At any point you can look at the Log sheet to see which prompts have been used and which ones have not been used.

Sub Random_Picks()
  Dim wsFull As Worksheet, wsLog As Worksheet
  Dim Pick As Long
  
  Set wsFull = Sheets("Sheet1")
  Set wsLog = Sheets("Log")
  Randomize
  wsFull.Activate
  With wsLog
    If IsEmpty(.Range("A1").Value) Then
      wsFull.Range("A2", wsFull.Range("A" & Rows.Count).End(xlUp)).Copy Destination:=.Range("A2")
      .Range("A1:B1").Value = Array("Unused", "Used")
    End If
    If IsEmpty(.Range("A2").Value) Then
      wsFull.Range("C2").ClearContents
      .UsedRange.ClearContents
      MsgBox "All used. Prompts have been reset. Try again"
    Else
      Pick = 2 + Int(Rnd() * (.Range("A" & Rows.Count).End(xlUp).Row - 1))
      wsFull.Range("C2").Value = .Range("A" & Pick).Value
      .Range("B" & Rows.Count).End(xlUp).Offset(1).Value = .Range("A" & Pick).Value
      .Cells(Pick, "A").Delete Shift:=xlUp
    End If
  End With
End Sub

 

[redhots4]

With Sheet1 as you have shown above. Name a blank sheet in the workbook as 'Log' and try running this code repeatedly.
At any point you can look at the Log sheet to see which prompts have been used and which ones have not been used.

Sub Random_Picks()
  Dim wsFull As Worksheet, wsLog As Worksheet
  Dim Pick As Long
 
  Set wsFull = Sheets("Sheet1")
  Set wsLog = Sheets("Log")
  Randomize
  wsFull.Activate
  With wsLog
    If IsEmpty(.Range("A1").Value) Then
      wsFull.Range("A2", wsFull.Range("A" & Rows.Count).End(xlUp)).Copy Destination:=.Range("A2")
      .Range("A1:B1").Value = Array("Unused", "Used")
    End If
    If IsEmpty(.Range("A2").Value) Then
      wsFull.Range("C2").ClearContents
      .UsedRange.ClearContents
      MsgBox "All used. Prompts have been reset. Try again"
    Else
      Pick = 2 + Int(Rnd() * (.Range("A" & Rows.Count).End(xlUp).Row - 1))
      wsFull.Range("C2").Value = .Range("A" & Pick).Value
      .Range("B" & Rows.Count).End(xlUp).Offset(1).Value = .Range("A" & Pick).Value
      .Cells(Pick, "A").Delete Shift:=xlUp
    End If
  End With
End Sub

Works beautifully, thank you!! Could you make a minor edit to enter the date & time in Column C, alongside "Used" to indicate the date / time each line was added to the Used log?

 

[Peter_SSs]

Works beautifully, thank you!! Could you make a minor edit to enter the date & time in Column C, alongside "Used" to indicate the date / time each line was added to the Used log?

Try this

Sub Random_Picks_v2()
  Dim wsFull As Worksheet, wsLog As Worksheet
  Dim Pick As Long
  
  Set wsFull = Sheets("Sheet1")
  Set wsLog = Sheets("Log")
  Randomize
  wsFull.Activate
  With wsLog
    If IsEmpty(.Range("A1").Value) Then
      wsFull.Range("A2", wsFull.Range("A" & Rows.Count).End(xlUp)).Copy Destination:=.Range("A2")
      .Range("A1:C1").Value = Array("Unused", "Used", "Date/Time")
    End If
    If IsEmpty(.Range("A2").Value) Then
      wsFull.Range("C2").ClearContents
      .UsedRange.ClearContents
      MsgBox "All used. Prompts have been reset. Try again"
    Else
      Pick = 2 + Int(Rnd() * (.Range("A" & Rows.Count).End(xlUp).Row - 1))
      wsFull.Range("C2").Value = .Range("A" & Pick).Value
      .Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Array(.Range("A" & Pick).Value, Now())
      .Cells(Pick, "A").Delete Shift:=xlUp
    End If
  End With
End Sub