Random sample VBA code - referencing Table header instead of position and removing a condition all together

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
740
Office Version
  1. 365
Platform
  1. Windows
Hello, I have this Random Sample code that I obtained from a very kind gentleman from this site, however I wish to make a modification to it and am unsure how to do so (many attempts have failed with errors).

I need 2 variations of the code.

The current code pulls a random sample from column 1 in a table based on the number provided in C1.
This is all fine however it also selects based on the condition of any cell that has a value "Yes" in column 14.

I need the part of the code that uses the condition of having "yes" in column 14 removed (not needed)

AND

another code that uses the condition "yes" based on the column header name "Mark" NOT position 14.

Would anyone be able to provide the 2 codes with these modifications?
Thank you very much!

ORIGINAL CODE:
VBA Code:
Sheets("Random Sample").Select
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("Table").ListObjects("Data").DataBodyRange.Value
  With CreateObject("Scripting.Dictionary")
  
   For R = 1 To UBound(Arr)
      If Arr(R, 14) = "Yes" 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("Random Sample").Range("B3").Resize(HowMany) = Application.Transpose(Arr)
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
For part one just remove this
VBA Code:
If Arr(R, 14) = "Yes" Then
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
And for part 2 try
VBA Code:
Sheets("Random Sample").Select
Dim R As Long, Cnt As Long, RandomIndex As Long, HowMany As Long, Arr As Variant, Tmp As Variant
Dim Col As Long
  HowMany = Sheets("Random Sample").Range("C1").Value
  Randomize
  With Sheets("Table").ListObjects("Data")
      Arr = .DataBodyRange.Value
      Col = .ListColumns("Mark").Index
  End With
  With CreateObject("Scripting.Dictionary")
  
   For R = 1 To UBound(Arr)
      If Arr(R, Col) = "Yes" 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("Random Sample").Range("B3").Resize(HowMany) = Application.Transpose(Arr)
 

willow1985

Well-known Member
Joined
Jul 24, 2019
Messages
740
Office Version
  1. 365
Platform
  1. Windows
And for part 2 try
VBA Code:
Sheets("Random Sample").Select
Dim R As Long, Cnt As Long, RandomIndex As Long, HowMany As Long, Arr As Variant, Tmp As Variant
Dim Col As Long
  HowMany = Sheets("Random Sample").Range("C1").Value
  Randomize
  With Sheets("Table").ListObjects("Data")
      Arr = .DataBodyRange.Value
      Col = .ListColumns("Mark").Index
  End With
  With CreateObject("Scripting.Dictionary")
 
   For R = 1 To UBound(Arr)
      If Arr(R, Col) = "Yes" 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("Random Sample").Range("B3").Resize(HowMany) = Application.Transpose(Arr)
First one works perfectly however the code that references the the column Mark is pulling randomly even if the cell has a different value then "Yes".

The column "Mark" contains an IF formula: =IF([@[Item '#]]<5,"Yes","No") if that helps...
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
63,974
Office Version
  1. 365
Platform
  1. Windows
Which column is the "mark" column & what is the value of Col?
 

Forum statistics

Threads
1,144,342
Messages
5,723,818
Members
422,518
Latest member
quack_quack

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
Top