5% Random Sample with Two Variables

[shou0028]

I need to do an audit of 5% of each of my coworkers complaint files. I pulled the data so that Column A contains the complaint file number, and Column B contains the complaint owner. There are about 7 different owners, but every complaint file number is different.

I need to pull out a random sample of 5% of each owner's complaints. Each owner does not have the same number of complaints, so 5% of one person's complaints might mean 10 complaints, by 5% of another person's complaints might mean 25.

I will be doing this audit monthly, so I'm looking to write a program or something so I just update my source data each month and it will generate a random sample of complaint file numbers from Column A.

Please let me know if I'm not explaining this well! Trying my best

 

[Asala42]

I think this is very plausible in excel.

Assumptions:
Column A contains file numbers. (A1 = "File Number", A2:A1000 contains file number data - for example purposes)
Column B contains complaint owners (B1 = "Owner", B2:B1000 contains owner data).

In C1 enter a column name (ex "Rand")
In C2 enter a formula: =RAND().
In D1 enter a column name (ex "Sample flag")
In D2 enter a formula: =IF(COUNTIF($B$2:B2,B2)/COUNTIF($B$2:$B$1000,B2)<5%,1,0)

Copy both formulas down.
Do a 2 layer sort on this new table: Sort by Owner then by Rand.

Column D will contain 0s and 1s, the 1s are a random 5% sample per owner. Just do a filter on that column for 1 and copy paste to your audit sheet.

If you want to generate a new sample, just hit F9 to recalculate the random numbers and repeat your sort and filter.

 

[DRSteele]

I took a different approach. This worksheet contains 1200 records of sample data, Column A being a Unique Id (like a file number) and Column B being an Owner's name. The formulas in Row4 Columns F through L look for matches of the Owner and report the top specified number of records (5% of the count of each Owner) in the unique ID column. The formulas are looking at columns A and B in their entirety but you can specify a range, a named range or Table name as desired; entire rows are slow to calculate, so keep that in mind. You'll have to copy the formulas down to exceed the number of rows you predict the sample count will be; in my example of 1200 records, each of the seven owner's names seemed to appear under 12 times so I went down 15 rows.

The sample data is randomly created with random numbers letters and names. You can copy and paste all the sample data as values to stop the randomisation.


Excel 2012

	A	B	C	D	E	F	G	H	I	J	K	L
1	Unique ID	Owner		Sample	Owner	Andrew	Bartholomew	Christopher	David	Ethan	Francisco	Gregory
2	U64433	Ethan			1200	179	158	175	166	164	178	180
3	E23759	David		5%	60	9	8	9	9	9	9	9
4	Y23581	Andrew				Y23581	H68222	D71591	E23759	U64433	D77242	D16739

<tbody>
</tbody>

Sheet17​

Worksheet Formulas Cell Formula A2 =CHAR(RANDBETWEEN(65,90))&RANDBETWEEN(10000,100000) B2 =LOOKUP(RANDBETWEEN(1,7),{1,2,3,4,5,6,7},{"Andrew","Bartholomew","Christopher","David","Ethan","Francisco","Gregory"}) A3 =CHAR(RANDBETWEEN(65,90))&RANDBETWEEN(10000,100000) B3 =LOOKUP(RANDBETWEEN(1,7),{1,2,3,4,5,6,7},{"Andrew","Bartholomew","Christopher","David","Ethan","Francisco","Gregory"}) A4 =CHAR(RANDBETWEEN(65,90))&RANDBETWEEN(10000,100000) B4 =LOOKUP(RANDBETWEEN(1,7),{1,2,3,4,5,6,7},{"Andrew","Bartholomew","Christopher","David","Ethan","Francisco","Gregory"}) E2 =SUM(F2:L2) F2 =COUNTIFS($B:$B,F1) G2 =COUNTIFS($B:$B,G1) H2 =COUNTIFS($B:$B,H1) I2 =COUNTIFS($B:$B,I1) J2 =COUNTIFS($B:$B,J1) K2 =COUNTIFS($B:$B,K1) L2 =COUNTIFS($B:$B,L1) E3 =ROUNDUP($D$3*E2,0) F3 =ROUNDUP($D$3*F2,0) G3 =ROUNDUP($D$3*G2,0) H3 =ROUNDUP($D$3*H2,0) I3 =ROUNDUP($D$3*I2,0) J3 =ROUNDUP($D$3*J2,0) K3 =ROUNDUP($D$3*K2,0) L3 =ROUNDUP($D$3*L2,0) <tbody> </tbody>

<tbody>
</tbody>

Array Formulas Cell Formula F4 {=IF(ROW()<=(F$3+3),IFERROR(INDEX($A:$A, SMALL(IF((F$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} G4 {=IF(ROW()<=(G$3+3),IFERROR(INDEX($A:$A, SMALL(IF((G$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} H4 {=IF(ROW()<=(H$3+3),IFERROR(INDEX($A:$A, SMALL(IF((H$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} I4 {=IF(ROW()<=(I$3+3),IFERROR(INDEX($A:$A, SMALL(IF((I$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} J4 {=IF(ROW()<=(J$3+3),IFERROR(INDEX($A:$A, SMALL(IF((J$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} K4 {=IF(ROW()<=(K$3+3),IFERROR(INDEX($A:$A, SMALL(IF((K$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} L4 {=IF(ROW()<=(L$3+3),IFERROR(INDEX($A:$A, SMALL(IF((L$1=$B:$B=TRUE),ROW($B:$B)),ROW()-ROW($B$1)-2)),""),"")} <tbody> </tbody> Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}. Note: Do not try and enter the {} manually yourself

<tbody>
</tbody>

 

[Kenneth Hobson]

In a Module, a VBA method might be like this below. You can then Filter by Column C's value of x or not where x marks the 5% random selection.

Sub Main()
  Dim f As Range, r5 As Long, u() As Variant, uu As Variant
  Dim a() As Variant, v() As Variant, vv As Variant
  Dim c As Range, col As String
  
  col = "C" 'Column to show an "x" for the 5% random pick
  
  u() = UniqueValues(Range("B2", Range("B" & Rows.Count).End(xlUp)))
  For Each uu In u()
    Set f = FoundRanges(Range("B2", Range("A" & Rows.Count).End(xlUp)), CStr(uu))
    If f Is Nothing Then GoTo NextV
    If f.Cells.Count <= 9 Then GoTo NextV
    '5% count, rounded.  9=0, 10=1, 20=1, 30=2, 40=2 etc.
    r5 = WorksheetFunction.Round(f.Cells.Count * 0.05, 0)
    v() = RndIntPick(1, f.Cells.Count, r5)
    For Each vv In v
      Set c = f(vv)
      Range(col & c.Row).Value2 = "x"
    Next vv
NextV:
  Next uu
End Sub



Function FoundRanges(fRange As Range, fStr As String) As Range
    Dim objFind As Range
    Dim rFound As Range, FirstAddress As String
     
    With fRange
        Set objFind = .Find(What:=fStr, After:=fRange.Cells((fRange.Rows.Count), fRange.Columns.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=True)
        If Not objFind Is Nothing Then
            Set rFound = objFind
            FirstAddress = objFind.Address
            Do
                Set objFind = .FindNext(objFind)
                If Not objFind Is Nothing Then Set rFound = Union(objFind, rFound)
            Loop While Not objFind Is Nothing And objFind.Address <> FirstAddress
        End If
    End With
    Set FoundRanges = rFound
End Function


Public Function UniqueValues(theRange As Range) As Variant
  Dim colUniques As New VBA.Collection
  Dim vArr As Variant
  Dim vCell As Variant
  Dim vLcell As Variant
  Dim oRng As Excel.Range
  Dim i As Long
  Dim vUnique As Variant
  Set oRng = Intersect(theRange, theRange.Parent.UsedRange)
  vArr = oRng
  On Error Resume Next
  For Each vCell In vArr
    If vCell <> vLcell Then
        If Len(CStr(vCell)) > 0 Then
             colUniques.Add vCell, CStr(vCell)
        End If
    End If
    vLcell = vCell
  Next vCell
  On Error GoTo 0
  'MsgBox colUniques.Count
  ReDim vUnique(1 To colUniques.Count)
  For i = LBound(vUnique) To UBound(vUnique)
    vUnique(i) = colUniques(i)
  Next i
  UniqueValues = vUnique
End Function

Function RndIntPick(first As Long, last As Long, _
  noPick As Long, Optional bSort As Boolean = False) As Variant
  Dim i As Long, r As Long, temp As Long, k As Long
  ReDim iArr(first To last) As Variant
  Dim a() As Variant
  
  For i = first To last
    iArr(i) = i
  Next i
  
  Randomize
  For i = 1 To noPick
      r = Int(Rnd() * (last - first + 1 - (i - 1))) + (first + (i - 1))
      temp = iArr(r)
      iArr(r) = iArr(first + i - 1)
      iArr(first + i - 1) = temp
  Next i
  
  ReDim Preserve iArr(first To first + noPick - 1)
  ReDim a(1 To noPick)
  For r = 1 To noPick
    a(r) = iArr(LBound(iArr) + r - 1)
  Next r
  
  If bSort = True Then
    RndIntPick = ArrayListSort(a())
    Else
    RndIntPick = a()
  End If
End Function

Function ArrayListSort(sn As Variant, Optional bAscending As Boolean = True)
  With CreateObject("System.Collections.ArrayList")
    Dim cl As Variant
    For Each cl In sn
        .Add cl
    Next
     
    .Sort 'Sort ascendending
    If bAscending = False Then .Reverse 'Sort and then Reverse to sort descending
    ArrayListSort = .toarray()
  End With
End Function