Multiple random sections per criteria

[Pheonix2332]

Evening all struggling to sleep as have this on my mind for work,

I have collated the weeks work from a different sheet into a new work book and organised it per member of staff, and now assigned a random number against it , however now I need to have an adjustable number of cases per member of staff to be produced into a separate list

An example being ( on phone so apologies for no screen shots)
Agent 1 has 3 cases out of 15 to be reviewed and the same for agent 2 to agent 30. And would need it to be able to change pending performance of the team so if doing well can be reduced to 2 and if performance drops increase it to 5 - can anybody advise how I could go about this please ?

 

[BSALV]

i didn't understand it completely, so ...

Map3
	A	B	C	D	E	F	G	H	I	J	K
1	person	jobs	inspection			performance now	3			performance	pro rata
2	person1	29	2			pro rata	15			0	0
3	person2	18	1							1	5
4	person3	33	2							2	10
5	person4	26	2							3	15
6	person5	23	2							4	20
7	person6	36	2							5	25
8	person7	20	1
9	person8	33	2
10	person9	33	2
11	person10	40	3
12	person11	31	2
13	person12	38	3
14	person13	35	2
15	person14	17	1
16	person15	33	2
17	person16	31	2
18	person17	24	2
19	person18	42	3
20	person19	12	1
21	person20	20	1
22	person21	26	2
23	person22	36	2
24	person23	41	3
25	person24	24	2
26	person25	14	1
27	person26	15	1
28	person27	25	2
29	person28	33	2
30	person29	39	3
31	person30	25	2
Blad1

Cell Formulas
Range	Formula
B2:B31	B2	=RANDBETWEEN(10,50)
C2:C31	C2	=IF($G$2=0,0,ROUND(B2/$G$2,0))
G2	G2	=VLOOKUP(G1,Tabel1,2,0)

 

[Pheonix2332]

i didn't understand it completely, so ...

sorry was not able to think clearly last night/ early this morning the lay out is like this

this is jsut a small sample of cases worked by 2 staff - with a random number generated against each case - I now need to have a way of having this now pull a variable number of cases per member of staff that is the same for all of them - so for 5289505 needs 2 cases and 6023284 needs 2 cases, the names are team managers who then need to run the checks I have on the start page this

so when the number of cases to generate changes after Generate it will only show that number max per PID ( staff member)

I have been using the following VBA to get to this point

 ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=RAND()"
    ActiveCell.Select
    Selection.Copy
    ActiveCell.Range("A1:A61").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    ActiveCell.Offset(4, -1).Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 1).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-2
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(-1, 0).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$F$1148").AutoFilter Field:=5, Criteria1:="<>"
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlUp).Select
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Range("A1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("data").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("data").AutoFilter.Sort.SortFields.Add Key:= _
        ActiveCell.Offset(-1, 0).Range("A1:A1148"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("data").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("data").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("data").AutoFilter.Sort.SortFields.Add Key:= _
        ActiveCell.Offset(-1, 0).Range("A1:A1148"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("data").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

this is a pre recoreded Macro from doing the copy and past to the new sheet and inserting the data needed so will need cleaning up however I need it now to use the random numbers assocated to each Pid in the sheet and then select them based from the cell value on the start sheet.

 

[BSALV]

you're still 2013, because in 2021-365, that can be done by formulas.
Can you add your data with the XL-BB-tool, that is easier to chat.

 

[Pheonix2332]

you're still 2013, because in 2021-365, that can be done by formulas.
Can you add your data with the XL-BB-tool, that is easier to chat.

unfortunately Due to IT restrictions I'm unable to use the XLBB tool, due to where I work they are extremely cautious of external download addons and I have not got the permissions to override it. work in the civil service in the UK

 

[BSALV]

Sub Pheonix()
     Dim Arr, Res(), MyKeys, MyItems, iNumber
     Set dict = CreateObject("scripting.dictionary")

     With Sheets("Results")
          iNumber = Range("G1").Value     'number of records / staff
          Arr = .Range("A1").CurrentRegion.Value2     'read the range around A1

     'collect all the rownumbers within Arr per staff-member *******************************************************************
          For i = 2 To UBound(Arr)     'loop through the data skipping the headerrow
               skey = Arr(i, 5)     'the staff
               If dict.exists(skey) Then     'exists already
                    dict(skey) = dict(skey) & vbLf & i     'add the row in the array to that key
               Else
                    dict(skey) = i     'add new key with the row within the array
               End If
          Next

     ' make a 2D-array with all the rownumber within Arr, which you random pick, iNumber per staff-member *******************************
          ReDim Res(1 To dict.Count * iNumber, 1 To 1)     'you 'll copy max the number of staffs * the number of records/staff
          MyKeys = dict.keys     'de keys of the dictionary
          MyItems = dict.items     'the items of the dictionary
          For i = 0 To UBound(MyKeys)     'loop through them
               sp = Split(MyItems(i), vbLf)     'split the items = string of all the rownumbers within the array Arr
               For j = 1 To iNumber     'as many records as demanded
                    r = Int(Rnd * (UBound(sp) + 2 - j))     'random pick
                    ptr = ptr + 1     'pointer within the array Res
                    Res(ptr, 1) = sp(r)     'rownumber in array Arr
                    sp(r) = sp(UBound(sp) + 1 - j)     'swap content within sp elements
                    If UBound(sp) - j + 1 <= 0 Then Exit For     'if not enough records for that staffmember, skip to next
               Next
          Next

     ' copy the selected rownumber to your destination   **********************************************************************
          .Range("I2").Resize(ptr, 5).Value = Application.Index(Arr, Res, Array(1, 2, 3, 4, 5))     'copy to I2
     End With
End Sub

Map1
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	test	s	date	manager	staff		10		test	s	date	manager	staff
2	2	2	25/07/22	2	Staff_1				137	137	11/07/22	137	Staff_7
3	3	3	31/07/22	3	Staff_9				69	69	14/06/22	69	Staff_7
4	4	4	23/04/22	4	Staff_4				117	117	10/05/22	117	Staff_7
5	5	5	3/06/22	5	Staff_3				79	79	16/07/22	79	Staff_7
6	6	6	13/07/22	6	Staff_1				228	228	26/05/22	228	Staff_7
7	7	7	12/07/22	7	Staff_5				211	211	26/04/22	211	Staff_7
8	8	8	13/05/22	8	Staff_8				47	47	28/04/22	47	Staff_7
9	9	9	14/06/22	9	Staff_10				183	183	24/07/22	183	Staff_7
10	10	10	14/05/22	10	Staff_7				193	193	22/07/22	193	Staff_7
11	11	11	20/07/22	11	Staff_4				102	102	16/07/22	102	Staff_8
12	12	12	21/05/22	12	Staff_10				92	92	27/04/22	92	Staff_8
13	13	13	12/05/22	13	Staff_1				15	15	29/04/22	15	Staff_8
Results

Cell Formulas
Range	Formula
D2:D13,A2:B13	A2	=ROW()
C2:C251	C2	=RANDARRAY(250,,TODAY(),TODAY()+100,1)
E2:E251	E2	="Staff_" & RANDARRAY(250,,1,10,1)
Dynamic array formulas.

 

[Pheonix2332]

this is fantastic!! Thank you so much !!! Saved me hours on this !