Random 12 sample with no duplicates and 1 condition

[willow1985]

Hello

I need help with acquiring a random 12 numbers from Column A in the blue table (right). No numbers can be duplicated on the list (column A on the left) and I need the formula to only select Work Order numbers that have an "N" in column E in the table (right)

(see below picture)

I hope I am explaining this well...

Thank you to anyone who can help

Carla

 

[Rick Rothstein]

Are those examples on two different sheets? If so, what are their names?

What is the table's name?

Is a VBA solution acceptable (I'm not sure how to do it with formulas)?

 

[willow1985]

Are those examples on two different sheets? If so, what are their names?

What is the table's name?

Is a VBA solution acceptable (I'm not sure how to do it with formulas)?

Yes they are 2 sheets. You can call them sheet 1 and sheet 2 and table. I will rename as needed. If you don't know a solution by formulas VBA is also welcome. Thank you very much!

 

[Rick Rothstein]

Give this macro a try...

Sub Carla()
  Dim R As Long, Cnt As Long, RandomIndex As Long, Arr As Variant, Tmp As Variant
  Const HowMany = 12
  Randomize
  Arr = Sheets("Sheet1").ListObjects("Table").DataBodyRange.Value
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Arr)
      If Arr(R, 5) = "N" Then .Item(CStr(Arr(R, 1))) = 1
    Next
    Arr = .Keys
  End With
  For Cnt = UBound(Arr) To LBound(Arr) Step -1
    RandomIndex = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr))
    Tmp = Arr(RandomIndex)
    Arr(RandomIndex) = Arr(Cnt)
    Arr(Cnt) = Tmp
  Next
  Sheets("Sheet2").Range("A3").Resize(HowMany) = Application.Transpose(Arr)
End Sub

 

[Peter_SSs]

It really would help if in future you could post sample data with XL2BB as you have done before. It saves helpers a lot of typing to set up to test.

I need the formula ...

Since you don't want repeats in the results, I have assumed no repeats in the table also.

willow1985.xlsm
	A				E
1	W/O Number				Previously Audited
2	1				Y
3	2				Y
4	3				N
5	4				N
6	5				Y
7	6				Y
8	7				N
9	8				N
10	9				Y
11	10				N
12	11				N
13	12				N
14	13				N
15	14				N
16	15				N
17	16				N
18	17				N
19	18				Y
20	19				N
Sheet2

You will need to adjust sheet, table & table column names to match your set-up.

willow1985.xlsm
	A
1
2	W/O Number
3	15
4	12
5	17
6	14
7	11
8	10
9	8
10	3
11	4
12	7
13	16
14	13
15
Sheet1

Cell Formulas
Range	Formula
A3:A14	A3	=AGGREGATE(15,6,IF(Table1[Previously Audited]="N",Table1[W/O Number],NA())/ISNA(MATCH(IF(Table1[Previously Audited]="N",Table1[W/O Number]),A$2:A2,0)),RANDBETWEEN(1,COUNTIF(Table1[Previously Audited],"N")-COUNT(A$2:A2)))

FWIW, this was my approach for a vba solution:

Sub Random_Values()
  Dim a As Variant
  Dim AL As Object
  Dim i As Long
  
  Randomize
  With Sheets("Sheet2").ListObjects("Table1").DataBodyRange
    a = Application.Index(.Cells.Value, Evaluate("row(1:" & .Rows.Count & ")"), Array(1, 5))
  End With
  Set AL = CreateObject("System.Collections.ArrayList")
  For i = 1 To UBound(a)
    If a(i, 2) = "N" Then AL.Add Rnd() & "#|" & a(i, 1)
  Next i
  AL.Sort
  a = Filter(Split(Join(AL.ToArray, "|"), "|"), "#", False)
  ReDim Preserve a(1 To 12)
  Sheets("Sheet1").Range("A3:A14").Value = Application.Transpose(a)
End Sub

 

[Rick Rothstein]

a = Filter(Split(Join(AL.ToArray, "|"), "|"), "#", False)
ReDim Preserve a(1 To 12)
Sheets("Sheet1").Range("A3:A14").Value = Application.Transpose(a

You can replace the above three lines of code from you macro with this single line of code and it will work the same...

Sheets("Sheet2").Range("A3:A14").Value = Application.Transpose(Filter(Split(Join(AL.ToArray, "|"), "|"), "#", False))

Here the receiving range limits the input to the first 12 items in the array so there is no need to ReDim Preserve to accomplish this same outcome.

 

[willow1985]

Give this macro a try...

Sub Carla()
  Dim R As Long, Cnt As Long, RandomIndex As Long, Arr As Variant, Tmp As Variant
  Const HowMany = 12
  Randomize
  Arr = Sheets("Sheet1").ListObjects("Table").DataBodyRange.Value
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Arr)
      If Arr(R, 5) = "N" Then .Item(CStr(Arr(R, 1))) = 1
    Next
    Arr = .Keys
  End With
  For Cnt = UBound(Arr) To LBound(Arr) Step -1
    RandomIndex = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr))
    Tmp = Arr(RandomIndex)
    Arr(RandomIndex) = Arr(Cnt)
    Arr(Cnt) = Tmp
  Next
  Sheets("Sheet2").Range("A3").Resize(HowMany) = Application.Transpose(Arr)
End Sub

This code is perfect.

A couple more questions though so I can understand the code better:

if I wanted to make it more basic and only select a random 12 from the list without worrying about the "N" Flag in column E what would I remove/modify of this code?
Also can I make the 12 sample size a cell reference instead where the user can control how many is selected?

Thank you very much!!

 

[Rick Rothstein]

To select random names without regard to the Y or Y flag, simply remove this part of the line of code inside the first For-Next loop and leave the rest as is...

If a(i, 2) = "N" Then

To make the code look at a cell for the number of random values to display, remove the entire Const statement and add this to the Dim statement...

HowMany As Long

then, in the code, assign the cell's value property to the HowMany variable.

 

[willow1985]

To select random names without regard to the Y or Y flag, simply remove this part of the line of code inside the first For-Next loop and leave the rest as is...

If a(i, 2) = "N" Then

To make the code look at a cell for the number of random values to display, remove the entire Const statement and add this to the Dim statement...

HowMany As Long

then, in the code, assign the cell's value property to the HowMany variable.

I am getting an error: Type mismatch with the last line before End Sub

Here is my new code:

Sub RS()
'
' RS Macro
'
  
      If Application.CountIf(Sheets("Random Sample").Range("E1"), "") > 0 Then
        MsgBox "Please Enter User Name"
        Exit Sub
    End If


  
  Dim R As Long, Cnt As Long, RandomIndex As Long, Arr As Variant, Tmp As Variant, HowMany As Long
  HowMany = Sheets("Random Sample").Range("C1").Value
  Randomize
  Arr = Sheets("DATA").ListObjects("DATA").DataBodyRange.Value
  With CreateObject("Scripting.Dictionary")
    
    Arr = .Keys
  End With
  For Cnt = UBound(Arr) To LBound(Arr) Step -1
    RandomIndex = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr))
    Tmp = Arr(RandomIndex)
    Arr(RandomIndex) = Arr(Cnt)
    Arr(Cnt) = Tmp
  Next
  Sheets("Random Sample").Range("B3").Resize(HowMany) = Application.Transpose(Arr)
  

End Sub

 

[Rick Rothstein]

You took out too much... you removed the entire loop where as I only wanted you to remove the part I showed you from the single code line inside the loop. Here is the entire macro with the changes (including your cell reference) in place...

Sub Carla()
  Dim R As Long, Cnt As Long, RandomIndex As Long, HowMany As Long, Arr As Variant, Tmp As Variant
  HowMany = Sheets("Random Sample").Range("C1").Value
  Randomize
  Arr = Sheets("Sheet1").ListObjects("Table").DataBodyRange.Value
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Arr)
      .Item(CStr(Arr(R, 1))) = 1
    Next
    Arr = .Keys
  End With
  For Cnt = UBound(Arr) To LBound(Arr) Step -1
    RandomIndex = Int((Cnt - LBound(Arr) + 1) * Rnd + LBound(Arr))
    Tmp = Arr(RandomIndex)
    Arr(RandomIndex) = Arr(Cnt)
    Arr(Cnt) = Tmp
  Next
  Sheets("Sheet2").Range("A3").Resize(HowMany) = Application.Transpose(Arr)
End Sub

NOTE: I did not include the test you added at the beginning of my macro. I would point out that it seems overly complicated for what I think it is doing. It looks like you should be able to test the cell for being empty and accomplish the same thing I think you are trying to do. If I am right, this would be my suggestion for the If..Then test...

If Sheets("Random Sample").Range("E1").Value = "" Then