Select Random Cells in the Selection

Hi

See if this gets you started.

Sub aaa()
  Dim arr As Variant
  strr = "How many to select"
  Do
    noofcells = Application.InputBox(strr, Type:=1)
    If noofcells > Selection.Cells.Count Then strr = "You must select a number less than " & Selection.Cells.Count + 1 & ".  How many to select?"
    
  Loop Until noofcells <= Selection.Cells.Count
  ReDim arr(noofcells)
  tot = 0
  Randomize
  For i = 0 To noofcells - 1
    arr(i) = Evaluate("=randbetween(1," & Selection.Cells.Count & ")")
  Next i
  
  If noofcells = 1 Then
    Selection.Cells(arr(0)).Select
  Else
    Set rng = Selection.Cells(arr(0))
    
    For i = 1 To noofcells - 1
      Set rng = Union(rng, Selection.Cells(arr(i)))
      
    Next i
    rng.Select
  End If
  
  
End Sub

rylo

This works GREAT! except I'm having one small problem... It allows it to randomly select the same cell, so if I have 20 and tell it to randomly select 10, i may only have 8 or 9 selections because it chose the same one twice... And I don't have the slightest clue on how to go about fixing this

Hi

Yea, I realised that this would be an issue, but wasn't sure how you would approach it.

Some thoughts:
1) only allow a selection number that is small enough that there is a high chance that you won't get repeats. So if you have 20 cells, then don't allow more than say 6 to be selected.

2) Another option is to keep cycling through the range until you have 10 distinct numbers. Maybe use a collection to store them all, and just keep looping until you reach your count

Do
    On Error Resume Next
    thisno = Evaluate("=randbetween(1,20)")
    nodupes.Add Item:=thisno, key:=CStr(thisno)
    On Error GoTo 0
  Loop Until nodupes.Count = 10
  
  For i = 1 To nodupes.Count
    Cells(i, 1).Value = nodupes(i)
  Next i

If you run the code above on a blank spreadsheet, you should get your list of unique numbers. You would have to make variables of the 10 and 20 that I have fixed above - have a look at the original code for ways to do that.

HTH

rylo

Thanks, but I'm getting an object required error on line:

Loop Until nodupes.Count = 10

Hi

Add the line

dim nodupes as new collection

before the do statement

rylo