Random pick up

[petitallien]

Good afternoon coming back to the community has it has been extremely helpful to me. So Let's start by a big THANK YOU ALL !
I am currently trying to implement and QA policy I can export the data from our system.
In column B there unique ID number associated to cases,in Colum X the Team Member who worked on it. And all kind of data in other columns

I would like to create a macro that does the following :
- For each team member, provide the number of cases managed
- Prompt the user to enter a number N
- keep in the list only N cases randomly selected

in other word, I am looking for a macro that provide the number of cases managed and ask for how many to keep. Something like the following flow.

Macro: " Bob managed 125 cases - How many cases have to be checked? "
User: 5
Macro:" Geraldine managed 456 cases - How many cases have to be checked? "
User: 7

Then the macro would return a tab with only 5 lines of Bob's and 7 of Geraldine's.

In my attempt so far I really struggle with the random part and I can't make it keep only what I am looking for.


final note: I would like to keep the entire line randomly selected.

Thank you all !

 

[Legacy 143009]

In the new tab, which columns would you like to include regarding the relevant team member? Just the case number?

 

[Legacy 143009]

This should work:

Sub test()
  Dim myRange As Variant, temArr As Variant, members As Object, cases As Integer, randomCases As Object, random As Integer, counter As Integer
  Set members = CreateObject("Scripting.dictionary")
  Set randomCases = CreateObject("Scripting.dictionary")
  With ActiveSheet
  myRange = Intersect(.UsedRange, .Range("A:X"))
  For i = 2 To UBound(myRange)
    If Not members.exists(myRange(i, 23)) Then
      members.Add myRange(i, 23), i
    End If
  Next
  For Each membersKey In members.Keys()
    tempArr = Filter2DArray(myRange, 23, membersKey, True)
    cases = InputBox(membersKey & " managed " & (UBound(tempArr) - 1) & " cases." & vbCrLf & "How many cases have to be checked?")
    Do While randomCases.Count <> cases
      random = (Timer * Rnd) Mod (UBound(tempArr) - 2 + 1) + 2
      If Not randomCases.exists(random) Then
        randomCases.Add random, i
      End If
    Loop
    Sheets.Add
    ActiveSheet.Name = membersKey
    With Worksheets(membersKey)
    .Range("B1").Resize(, UBound(myRange, 2)).Value = Application.WorksheetFunction.Index(myRange, 1, 0)
    c = 2
    For Each rand In randomCases
      .Range("B" & c).Resize(, UBound(myRange, 2)).Value = Application.WorksheetFunction.Index(tempArr, rand, 0)
      c = c + 1
    Next
    End With
  Next
  End With
End Sub
Function Filter2DArray(ByVal sArray, ByVal ColIndex As Long, ByVal FindStr As String, ByVal HasTitle As Boolean)
  Dim tmpArr, i As Long, j As Long, Arr, Dic, TmpStr, Tmp, Chk As Boolean, TmpVal As Double
  On Error Resume Next
  Set Dic = CreateObject("Scripting.Dictionary")
  tmpArr = sArray
  ColIndex = ColIndex + LBound(tmpArr, 2) - 1
  Chk = (InStr("><=", Left(FindStr, 1)) > 0)
  For i = LBound(tmpArr, 1) - HasTitle To UBound(tmpArr, 1)
    If Chk Then
      TmpVal = CDbl(tmpArr(i, ColIndex))
      If Evaluate(TmpVal & FindStr) Then Dic.Add i, ""
    Else
      If UCase(tmpArr(i, ColIndex)) Like UCase(FindStr) Then Dic.Add i, ""
    End If
  Next
  If Dic.Count > 0 Then
    Tmp = Dic.Keys
    ReDim Arr(LBound(tmpArr, 1) To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle, LBound(tmpArr, 2) To UBound(tmpArr, 2))
    For i = LBound(tmpArr, 1) - HasTitle To UBound(Tmp) + LBound(tmpArr, 1) - HasTitle
      For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
        Arr(i, j) = tmpArr(Tmp(i - LBound(tmpArr, 1) + HasTitle), j)
      Next
    Next
    If HasTitle Then
      For j = LBound(tmpArr, 2) To UBound(tmpArr, 2)
        Arr(LBound(tmpArr, 1), j) = tmpArr(LBound(tmpArr, 1), j)
      Next
    End If
  End If
  Filter2DArray = Arr
End Function

 

[petitallien]

Thank you for the extremely quick answer. I did not expected it so quick.
to answer the question, iIdeally I would like to have the entire line for case.

I tried the macro there but it ask how many cases needs to be checked then run forever.
This being said... I can't do better. Thank you Flashbond

 

[Legacy 143009]

Could you provide a sample workbook please?

 

[Legacy 143009]

Please find the sample file:

Kitap1 (2).xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

I am not sharing the code because it is the same as in post#3