Randomly selecting items so that they don't repeat

[vas54404]

Hi All,

I am creating a sheet in which I have to select 5 random items out of 20 items. However, if 5 items are selected in round 1, round 2 should have 5 values from the remaining 15 items, round 3 from the remaining 10, and at last the remaining 4.
I am using following code but there is an error after round 1 as values get repeated. Here is my code:

Thanks for your help!
Abhishek

"
Sub Macro2()
'
' Macro2 Macro
'


'
Range("B6").Select
ActiveCell.FormulaR1C1 = "=RAND()"
Range("B6").Select
Selection.AutoFill Destination:=Range("B6:B25"), Type:=xlFillDefault
Range("B6:B25").Select
Range("C6").Select
ActiveCell.FormulaR1C1 = "=INDEX(R6C1:R25C1,RANK(RC[-1],R6C2:R25C2))"
Range("C6").Select
Selection.AutoFill Destination:=Range("C6:C10"), Type:=xlFillDefault
Range("C6:C10").Select
Selection.Copy
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-4],R6C[-1]:R25C[-1],1,FALSE)),RC[-4],"""")"
Range("E6").Select
Selection.AutoFill Destination:=Range("E6:E25"), Type:=xlFillDefault
Range("E6:E25").Select
Selection.Copy
Range("F6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
ActiveWindow.SmallScroll ToRight:=3
Range("G25").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$5:$S$25").AutoFilter Field:=6, Criteria1:="<>"
Range("F7:F25").Select
Selection.Copy
ActiveSheet.Range("$A$5:$S$25").AutoFilter Field:=6
Range("G6").Select
Selection = Selection.Value
Application.CutCopyMode = False
Range("H6").Select
ActiveCell.FormulaR1C1 = "=RAND()"
Range("H6").Select
Selection.AutoFill Destination:=Range("H6:H20"), Type:=xlFillDefault
Range("H6:H20").Select
ActiveWindow.SmallScroll ToRight:=2
Range("I6:I10").Select
Selection.Copy
Range("J6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("K6").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-4],R6C[-1]:R20C[-1],1,FALSE)),RC[-4],"""")"
Range("K6").Select
Selection.AutoFill Destination:=Range("K6:K20"), Type:=xlFillDefault
Range("K6:K20").Select
Selection.Copy
Range("L6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
ActiveWindow.SmallScroll ToRight:=3
Range("N25").Select
Application.CutCopyMode = False
ActiveSheet.Range("$A$5:$S$25").AutoFilter Field:=12, Criteria1:="<>"
Range("L6:L20").Select
Selection.Copy
ActiveSheet.Range("$A$5:$S$25").AutoFilter Field:=12
Range("M6").Select
Selection = Selection.Value
Range("N6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RAND()"
Range("N6").Select
Selection.AutoFill Destination:=Range("N6:N10"), Type:=xlFillDefault
Range("N6:N10").Select
Range("O6").Select
ActiveCell.FormulaR1C1 = "=INDEX(R6C13:R15C13,RANK(RC[-1],R6C14:R15C14))"
Range("O6").Select
Selection.AutoFill Destination:=Range("O6:O10"), Type:=xlFillDefault
Range("O6:O10").Select
Selection.Copy
Range("P6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.SmallScroll ToRight:=3
Range("Q6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-4],R6C[-1]:R15C[-1],1,FALSE)),RC[-4],"""")"
Range("Q6").Select
Selection.AutoFill Destination:=Range("Q6:Q15"), Type:=xlFillDefault
Range("Q6:Q15").Select
Selection.Copy
Range("R6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Range("R21").Select
ActiveSheet.Range("$A$5:$S$25").AutoFilter Field:=18, Criteria1:="<>"
Range("R11:R15").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Range("$A$5:$S$25").AutoFilter Field:=18
Range("S6").Select
Selection = Selection.Value
End Sub
"

 

[cerfani]

use Collections... https://excelmacromastery.com/excel-vba-collections/

https://www.techonthenet.com/excel/formulas/rnd.php (Always call Randomize before Rnd)

I recommend... adding selected items to a collection and to retry a random selection if the value is contained in the collection (meaning it was previously selected)

 

[vas54404]

The problem with my formula is that I get 5 items in round 1. However, when I copy items (by filtering blank items and paste on next column) from the remaining 15 items, the values are different than what I copied while filtering and so on..

 

[cerfani]

Sounds like you are copying from formulas that when pasted elsewhere update the relative cell references and create different calculations... you are doing... (not your code btw)

Range("A1").Select
Selection.Copy
Range("P6").Select
Selection.Paste

that is what the macro recorder creates and is harder to visualize. It would be better if you wrote your code like this...

Range("A1").Copy Range("P6")

but that would copy a formula over and if the cell references are not locked can change the formula cell references and the calculation itself. So you can do instead...

Range("P6").Value = Range("A1").Value

i would suggest optimizing your code so it is easier to read and edit. Im pretty good with VBA but when i read your code it is just a wall of text. Make your code easy to read and people can give you better help. That goes for anything really.

 

[Rick Rothstein]

Assuming you have the values that you want randomized in Column B starting in Row 6, the following macro will randomize and distribute those values, without repeats, into columns of 5 cells downward each, side by side, for as many total values as you have starting at cell C6...

Sub RandomizeArray()
  Dim Cnt As Long, RndIndx As Long, Tmp As Variant, Arr As Variant
  Const CellsDown As Long = 5
  Const StartCell As String = "B6"
  Const OutCell As String = "C6"
  Randomize
  Arr = Range(StartCell).Resize(20)
  For Cnt = UBound(Arr) To 1 Step -1
    RndIndx = Int(Cnt * Rnd + 1)
    Tmp = Arr(RndIndx, 1)
    Arr(RndIndx, 1) = Arr(Cnt, 1)
    Arr(Cnt, 1) = Tmp
  Next
  For Cnt = 1 To UBound(Arr) Step CellsDown
    Range(OutCell).Offset(, (Cnt - 1) / CellsDown).Resize(CellsDown) = Application.Index(Arr, Evaluate("ROW(" & Cnt & ":" & Cnt + CellsDown & ")"))
  Next
End Sub